YS_501_60.KID

KIDS Distribution saved on Aug 15, 2012@11:26:08
YS*5.01*60 & GMTS*2.7*102
**KIDS**:YS*5.01*60^GMTS*2.7*102^

**INSTALL NAME**
YS*5.01*60
"BLD",19324,0)
YS*5.01*60^MENTAL HEALTH^0^3120815^y
"BLD",19324,1,0)
^^8^8^3120430^
"BLD",19324,1,1,0)
Patch YS*5.01*60 addresses the retirement of Mental Health Options, Files,
"BLD",19324,1,2,0)
Data Dictionaries, patient data associated with these files, and
"BLD",19324,1,3,0)
associated templates determined by the Mental Health Strategic Healthcare
"BLD",19324,1,4,0)
Group to be obsolete and are no longer supported by Health Systems Design
"BLD",19324,1,5,0)
and Development.  All the software, files, options, and templates were
"BLD",19324,1,6,0)
designated as obsolete in 2004 or earlier.
"BLD",19324,1,7,0)
 
"BLD",19324,1,8,0)
A complete description of this patch can be found on Forum.
"BLD",19324,4,0)
^9.64PA^^
"BLD",19324,6.3)
47
"BLD",19324,"ABPKG")
n
"BLD",19324,"INI")
YS60PRE
"BLD",19324,"INID")
^y^y
"BLD",19324,"INIT")
YS60POST
"BLD",19324,"KRN",0)
^9.67PA^779.2^20
"BLD",19324,"KRN",.4,0)
.4
"BLD",19324,"KRN",.4,"NM",0)
^9.68A^1^1
"BLD",19324,"KRN",.4,"NM",1,0)
YSJOB    FILE #624^624^1^
"BLD",19324,"KRN",.4,"NM","B","YSJOB    FILE #624",1)

"BLD",19324,"KRN",.401,0)
.401
"BLD",19324,"KRN",.402,0)
.402
"BLD",19324,"KRN",.402,"NM",0)
^9.68A^1^1
"BLD",19324,"KRN",.402,"NM",1,0)
YSCEN UNIT DEF    FILE #618^618^1^
"BLD",19324,"KRN",.402,"NM","B","YSCEN UNIT DEF    FILE #618",1)

"BLD",19324,"KRN",.403,0)
.403
"BLD",19324,"KRN",.403,"NM",0)
^9.68A^^
"BLD",19324,"KRN",.5,0)
.5
"BLD",19324,"KRN",.84,0)
.84
"BLD",19324,"KRN",3.6,0)
3.6
"BLD",19324,"KRN",3.8,0)
3.8
"BLD",19324,"KRN",9.2,0)
9.2
"BLD",19324,"KRN",9.2,"NM",0)
^9.68A^1^1
"BLD",19324,"KRN",9.2,"NM",1,0)
YS-PHY-EXAM-NORM^^0
"BLD",19324,"KRN",9.2,"NM","B","YS-PHY-EXAM-NORM",1)

"BLD",19324,"KRN",9.8,0)
9.8
"BLD",19324,"KRN",9.8,"NM",0)
^9.68A^298^229
"BLD",19324,"KRN",9.8,"NM",1,0)
YSASCF^^1^
"BLD",19324,"KRN",9.8,"NM",2,0)
YSCEN^^1^
"BLD",19324,"KRN",9.8,"NM",3,0)
YSCEN1^^1^
"BLD",19324,"KRN",9.8,"NM",4,0)
YSCEN10^^1^
"BLD",19324,"KRN",9.8,"NM",5,0)
YSCEN13^^0^B982218
"BLD",19324,"KRN",9.8,"NM",6,0)
YSCEN14^^1^
"BLD",19324,"KRN",9.8,"NM",7,0)
YSCEN2^^1^
"BLD",19324,"KRN",9.8,"NM",8,0)
YSCEN21^^1^
"BLD",19324,"KRN",9.8,"NM",9,0)
YSCEN22^^1^
"BLD",19324,"KRN",9.8,"NM",10,0)
YSCEN23^^1^
"BLD",19324,"KRN",9.8,"NM",11,0)
YSCEN24^^1^
"BLD",19324,"KRN",9.8,"NM",12,0)
YSCEN26^^1^
"BLD",19324,"KRN",9.8,"NM",13,0)
YSCEN3^^1^
"BLD",19324,"KRN",9.8,"NM",14,0)
YSCEN31^^1^
"BLD",19324,"KRN",9.8,"NM",15,0)
YSCEN32^^1^
"BLD",19324,"KRN",9.8,"NM",16,0)
YSCEN33^^1^
"BLD",19324,"KRN",9.8,"NM",17,0)
YSCEN34^^1^
"BLD",19324,"KRN",9.8,"NM",18,0)
YSCEN35^^1^
"BLD",19324,"KRN",9.8,"NM",19,0)
YSCEN36^^1^
"BLD",19324,"KRN",9.8,"NM",20,0)
YSCEN37^^1^
"BLD",19324,"KRN",9.8,"NM",21,0)
YSCEN39^^1^
"BLD",19324,"KRN",9.8,"NM",22,0)
YSCEN4^^1^
"BLD",19324,"KRN",9.8,"NM",23,0)
YSCEN41^^1^
"BLD",19324,"KRN",9.8,"NM",24,0)
YSCEN5^^0^B5014852
"BLD",19324,"KRN",9.8,"NM",25,0)
YSCEN51^^1^
"BLD",19324,"KRN",9.8,"NM",26,0)
YSCEN52^^1^
"BLD",19324,"KRN",9.8,"NM",27,0)
YSCEN53^^1^
"BLD",19324,"KRN",9.8,"NM",28,0)
YSCEN54^^1^
"BLD",19324,"KRN",9.8,"NM",29,0)
YSCEN55^^1^
"BLD",19324,"KRN",9.8,"NM",30,0)
YSCEN56^^1^
"BLD",19324,"KRN",9.8,"NM",31,0)
YSCEN6^^1^
"BLD",19324,"KRN",9.8,"NM",32,0)
YSCEN61^^1^
"BLD",19324,"KRN",9.8,"NM",33,0)
YSCEN7^^1^
"BLD",19324,"KRN",9.8,"NM",34,0)
YSCEN8^^1^
"BLD",19324,"KRN",9.8,"NM",35,0)
YSCEN81^^1^
"BLD",19324,"KRN",9.8,"NM",36,0)
YS06ENV^^1^
"BLD",19324,"KRN",9.8,"NM",37,0)
YSCUP^^1^
"BLD",19324,"KRN",9.8,"NM",38,0)
YSCUP000^^1^
"BLD",19324,"KRN",9.8,"NM",39,0)
YSCUP001^^1^
"BLD",19324,"KRN",9.8,"NM",40,0)
YSCUP002^^1^
"BLD",19324,"KRN",9.8,"NM",41,0)
YSCUP003^^1^
"BLD",19324,"KRN",9.8,"NM",42,0)
YSCUP004^^1^
"BLD",19324,"KRN",9.8,"NM",43,0)
YSEMSG^^1^
"BLD",19324,"KRN",9.8,"NM",44,0)
YSESA^^1^
"BLD",19324,"KRN",9.8,"NM",45,0)
YSESD^^1^
"BLD",19324,"KRN",9.8,"NM",46,0)
YSESE^^1^
"BLD",19324,"KRN",9.8,"NM",47,0)
YSESED^^1^
"BLD",19324,"KRN",9.8,"NM",48,0)
YSESH^^1^
"BLD",19324,"KRN",9.8,"NM",49,0)
YSESL^^1^
"BLD",19324,"KRN",9.8,"NM",50,0)
YSESLOG^^1^
"BLD",19324,"KRN",9.8,"NM",51,0)
YSESM^^1^
"BLD",19324,"KRN",9.8,"NM",52,0)
YSESN^^1^
"BLD",19324,"KRN",9.8,"NM",53,0)
YSESP^^1^
"BLD",19324,"KRN",9.8,"NM",54,0)
YSESR^^1^
"BLD",19324,"KRN",9.8,"NM",55,0)
YSESUT^^1^
"BLD",19324,"KRN",9.8,"NM",56,0)
YSGAF3^^0^B95532
"BLD",19324,"KRN",9.8,"NM",57,0)
YSHELP^^1^
"BLD",19324,"KRN",9.8,"NM",58,0)
YSJOB^^1^
"BLD",19324,"KRN",9.8,"NM",59,0)
YSJOBK^^1^
"BLD",19324,"KRN",9.8,"NM",60,0)
YSKFASIM^^1^
"BLD",19324,"KRN",9.8,"NM",61,0)
YSPHY^^1^
"BLD",19324,"KRN",9.8,"NM",62,0)
YSPHY1^^1^
"BLD",19324,"KRN",9.8,"NM",63,0)
YSPHYR^^1^
"BLD",19324,"KRN",9.8,"NM",64,0)
YSPP^^1^
"BLD",19324,"KRN",9.8,"NM",65,0)
YSPP1^^1^
"BLD",19324,"KRN",9.8,"NM",66,0)
YSPP2^^1^
"BLD",19324,"KRN",9.8,"NM",67,0)
YSPP3^^1^
"BLD",19324,"KRN",9.8,"NM",68,0)
YSPP4^^1^
"BLD",19324,"KRN",9.8,"NM",69,0)
YSPP5^^1^
"BLD",19324,"KRN",9.8,"NM",70,0)
YSPP6^^1^
"BLD",19324,"KRN",9.8,"NM",71,0)
YSPP7^^1^
"BLD",19324,"KRN",9.8,"NM",72,0)
YSPP8^^1^
"BLD",19324,"KRN",9.8,"NM",73,0)
YSPP9^^1^
"BLD",19324,"KRN",9.8,"NM",74,0)
YSPPJ^^1^
"BLD",19324,"KRN",9.8,"NM",75,0)
YSPRBR1^^1^
"BLD",19324,"KRN",9.8,"NM",76,0)
YSPRBR2^^1^
"BLD",19324,"KRN",9.8,"NM",77,0)
YSPROB^^1^
"BLD",19324,"KRN",9.8,"NM",78,0)
YSPROB1^^1^
"BLD",19324,"KRN",9.8,"NM",79,0)
YSPROB2^^1^
"BLD",19324,"KRN",9.8,"NM",80,0)
YSPROB3^^1^
"BLD",19324,"KRN",9.8,"NM",81,0)
YSPROB4^^1^
"BLD",19324,"KRN",9.8,"NM",82,0)
YSPROB5^^1^
"BLD",19324,"KRN",9.8,"NM",83,0)
YSPROBR^^1^
"BLD",19324,"KRN",9.8,"NM",84,0)
YSPROBR1^^1^
"BLD",19324,"KRN",9.8,"NM",85,0)
YSPROSE^^1^
"BLD",19324,"KRN",9.8,"NM",86,0)
YSPTX^^1^
"BLD",19324,"KRN",9.8,"NM",87,0)
YSPTX1^^1^
"BLD",19324,"KRN",9.8,"NM",88,0)
YSPTXR^^1^
"BLD",19324,"KRN",9.8,"NM",89,0)
YSWX^^1^
"BLD",19324,"KRN",9.8,"NM",90,0)
YSWX1^^1^
"BLD",19324,"KRN",9.8,"NM",91,0)
YSWZ^^1^
"BLD",19324,"KRN",9.8,"NM",97,0)
YSXRAG^^1^
"BLD",19324,"KRN",9.8,"NM",98,0)
YSXRAG1^^1^
"BLD",19324,"KRN",9.8,"NM",99,0)
YSXRAG2^^1^
"BLD",19324,"KRN",9.8,"NM",129,0)
YSXRBA^^1^
"BLD",19324,"KRN",9.8,"NM",130,0)
YSXRBA1^^1^
"BLD",19324,"KRN",9.8,"NM",131,0)
YSXRBA2^^1^
"BLD",19324,"KRN",9.8,"NM",132,0)
YSXRBA3^^1^
"BLD",19324,"KRN",9.8,"NM",133,0)
YSXRBA4^^1^
"BLD",19324,"KRN",9.8,"NM",134,0)
YSXRBA5^^1^
"BLD",19324,"KRN",9.8,"NM",135,0)
YSXRBA6^^1^
"BLD",19324,"KRN",9.8,"NM",136,0)
YTQQI001^^1^
"BLD",19324,"KRN",9.8,"NM",137,0)
YTQQI002^^1^
"BLD",19324,"KRN",9.8,"NM",138,0)
YTQQI003^^1^
"BLD",19324,"KRN",9.8,"NM",139,0)
YTQQI004^^1^
"BLD",19324,"KRN",9.8,"NM",140,0)
YTQQI005^^1^
"BLD",19324,"KRN",9.8,"NM",141,0)
YTQQI006^^1^
"BLD",19324,"KRN",9.8,"NM",142,0)
YTQQI007^^1^
"BLD",19324,"KRN",9.8,"NM",143,0)
YTQQI008^^1^
"BLD",19324,"KRN",9.8,"NM",144,0)
YTQQI009^^1^
"BLD",19324,"KRN",9.8,"NM",145,0)
YTQQI00A^^1^
"BLD",19324,"KRN",9.8,"NM",146,0)
YTQQI00B^^1^
"BLD",19324,"KRN",9.8,"NM",147,0)
YTQQI00C^^1^
"BLD",19324,"KRN",9.8,"NM",148,0)
YTQQI00D^^1^
"BLD",19324,"KRN",9.8,"NM",149,0)
YTQQI00E^^1^
"BLD",19324,"KRN",9.8,"NM",150,0)
YTQQI00F^^1^
"BLD",19324,"KRN",9.8,"NM",151,0)
YTQQI00G^^1^
"BLD",19324,"KRN",9.8,"NM",152,0)
YTQQI00H^^1^
"BLD",19324,"KRN",9.8,"NM",153,0)
YTQQI00I^^1^
"BLD",19324,"KRN",9.8,"NM",154,0)
YTQQI00J^^1^
"BLD",19324,"KRN",9.8,"NM",155,0)
YTQQI00K^^1^
"BLD",19324,"KRN",9.8,"NM",156,0)
YTS^^0^B16658002
"BLD",19324,"KRN",9.8,"NM",157,0)
YS85POST^^1^
"BLD",19324,"KRN",9.8,"NM",158,0)
YS85PRE^^1^
"BLD",19324,"KRN",9.8,"NM",159,0)
YSCPAF^^1^
"BLD",19324,"KRN",9.8,"NM",160,0)
YSCPAG^^1^
"BLD",19324,"KRN",9.8,"NM",161,0)
YSCPAI^^1^
"BLD",19324,"KRN",9.8,"NM",162,0)
YSCPAK^^1^
"BLD",19324,"KRN",9.8,"NM",163,0)
YSCPAL^^1^
"BLD",19324,"KRN",9.8,"NM",164,0)
YSCPAM^^1^
"BLD",19324,"KRN",9.8,"NM",165,0)
YSCPAQ^^1^
"BLD",19324,"KRN",9.8,"NM",166,0)
YSD40030^^1^
"BLD",19324,"KRN",9.8,"NM",167,0)
YSD40031^^1^
"BLD",19324,"KRN",9.8,"NM",168,0)
YSD40032^^1^
"BLD",19324,"KRN",9.8,"NM",169,0)
YSD40040^^1^
"BLD",19324,"KRN",9.8,"NM",170,0)
YSD40041^^1^
"BLD",19324,"KRN",9.8,"NM",171,0)
YSD40042^^1^
"BLD",19324,"KRN",9.8,"NM",172,0)
YSD40050^^1^
"BLD",19324,"KRN",9.8,"NM",173,0)
YSD40051^^1^
"BLD",19324,"KRN",9.8,"NM",174,0)
YSD40052^^1^
"BLD",19324,"KRN",9.8,"NM",175,0)
YSD40060^^1^
"BLD",19324,"KRN",9.8,"NM",176,0)
YSD40061^^1^
"BLD",19324,"KRN",9.8,"NM",177,0)
YSD40062^^1^
"BLD",19324,"KRN",9.8,"NM",178,0)
YSD4C000^^1^
"BLD",19324,"KRN",9.8,"NM",179,0)
YSD4CK00^^1^
"BLD",19324,"KRN",9.8,"NM",180,0)
YSD4DSM^^1^
"BLD",19324,"KRN",9.8,"NM",181,0)
YSD4E010^^1^
"BLD",19324,"KRN",9.8,"NM",182,0)
YSD4E020^^1^
"BLD",19324,"KRN",9.8,"NM",183,0)
YSD4POS0^^1^
"BLD",19324,"KRN",9.8,"NM",184,0)
YSD4PRE^^1^
"BLD",19324,"KRN",9.8,"NM",185,0)
YSD4UT01^^1^
"BLD",19324,"KRN",9.8,"NM",186,0)
YSHX1^^1^
"BLD",19324,"KRN",9.8,"NM",187,0)
YSHX1R^^1^
"BLD",19324,"KRN",9.8,"NM",188,0)
YSKFASI1^^1^
"BLD",19324,"KRN",9.8,"NM",189,0)
YSKFASI2^^1^
"BLD",19324,"KRN",9.8,"NM",190,0)
YSKFASIF^^1^
"BLD",19324,"KRN",9.8,"NM",191,0)
YSMV^^1^
"BLD",19324,"KRN",9.8,"NM",192,0)
YSMV1^^1^
"BLD",19324,"KRN",9.8,"NM",193,0)
YSONIT^^1^
"BLD",19324,"KRN",9.8,"NM",194,0)
YSONIT1^^1^
"BLD",19324,"KRN",9.8,"NM",195,0)
YSONIT2^^1^
"BLD",19324,"KRN",9.8,"NM",196,0)
YSONIT3^^1^
"BLD",19324,"KRN",9.8,"NM",220,0)
YTMCMI2B^^0^B14715804
"BLD",19324,"KRN",9.8,"NM",221,0)
YTMCMI2C^^0^B21611132
"BLD",19324,"KRN",9.8,"NM",222,0)
YSSITE^^0^B3477669
"BLD",19324,"KRN",9.8,"NM",223,0)
YSD4POST^^1^
"BLD",19324,"KRN",9.8,"NM",224,0)
YS05POST^^1^
"BLD",19324,"KRN",9.8,"NM",226,0)
YSDX0001^^1^
"BLD",19324,"KRN",9.8,"NM",227,0)
YSDX0002^^1^
"BLD",19324,"KRN",9.8,"NM",228,0)
YSDX3^^0^B10581455
"BLD",19324,"KRN",9.8,"NM",229,0)
YSDXR^^0^B3156016
"BLD",19324,"KRN",9.8,"NM",230,0)
YSDXR000^^1^
"BLD",19324,"KRN",9.8,"NM",231,0)
YSDXR1^^1^
"BLD",19324,"KRN",9.8,"NM",232,0)
YSPDR1^^1^
"BLD",19324,"KRN",9.8,"NM",233,0)
YSPDXR^^1^
"BLD",19324,"KRN",9.8,"NM",234,0)
YSDX3UA^^0^B17115146
"BLD",19324,"KRN",9.8,"NM",236,0)
YSASPNT^^0^B10291993
"BLD",19324,"KRN",9.8,"NM",238,0)
YSLOCN^^0^B1428676
"BLD",19324,"KRN",9.8,"NM",240,0)
YTMMPI2^^0^B20251423
"BLD",19324,"KRN",9.8,"NM",242,0)
YTAPI7^^0^B16428780
"BLD",19324,"KRN",9.8,"NM",243,0)
YTONLY^^0^B29076478
"BLD",19324,"KRN",9.8,"NM",251,0)
YSLRP^^0^B836128
"BLD",19324,"KRN",9.8,"NM",252,0)
YSASNAR^^0^B38698089
"BLD",19324,"KRN",9.8,"NM",253,0)
YSMHMENU^^0^B571680
"BLD",19324,"KRN",9.8,"NM",254,0)
YTEX^^1^
"BLD",19324,"KRN",9.8,"NM",255,0)
YTTB^^1^
"BLD",19324,"KRN",9.8,"NM",256,0)
YSSR^^0^B31889856
"BLD",19324,"KRN",9.8,"NM",257,0)
YSSR1^^0^B21510369
"BLD",19324,"KRN",9.8,"NM",258,0)
YSSR2^^0^B7632392
"BLD",19324,"KRN",9.8,"NM",259,0)
YSSRU^^0^B20557028
"BLD",19324,"KRN",9.8,"NM",260,0)
YSD4PRE0^^1^
"BLD",19324,"KRN",9.8,"NM",261,0)
YSNTEG^^1^
"BLD",19324,"KRN",9.8,"NM",262,0)
YSPP1A^^1^
"BLD",19324,"KRN",9.8,"NM",263,0)
YSNTEG0^^1^
"BLD",19324,"KRN",9.8,"NM",264,0)
YS03ENV^^1^
"BLD",19324,"KRN",9.8,"NM",265,0)
YS04ENV^^1^
"BLD",19324,"KRN",9.8,"NM",266,0)
YS04POST^^1^
"BLD",19324,"KRN",9.8,"NM",267,0)
YS05ENV^^1^
"BLD",19324,"KRN",9.8,"NM",268,0)
YS23ENV^^1^
"BLD",19324,"KRN",9.8,"NM",269,0)
YS23POST^^1^
"BLD",19324,"KRN",9.8,"NM",270,0)
YS24ENV^^1^
"BLD",19324,"KRN",9.8,"NM",271,0)
YS24POST^^1^
"BLD",19324,"KRN",9.8,"NM",272,0)
YS26ENV^^1^
"BLD",19324,"KRN",9.8,"NM",273,0)
YS29ENV^^1^
"BLD",19324,"KRN",9.8,"NM",274,0)
YS30ENV^^1^
"BLD",19324,"KRN",9.8,"NM",275,0)
YS30PRE^^1^
"BLD",19324,"KRN",9.8,"NM",276,0)
YS32ENV^^1^
"BLD",19324,"KRN",9.8,"NM",277,0)
YS33ENV^^1^
"BLD",19324,"KRN",9.8,"NM",278,0)
YS37ENV^^1^
"BLD",19324,"KRN",9.8,"NM",279,0)
YS38ENV^^1^
"BLD",19324,"KRN",9.8,"NM",280,0)
YS38POST^^1^
"BLD",19324,"KRN",9.8,"NM",281,0)
YS39POST^^1^
"BLD",19324,"KRN",9.8,"NM",282,0)
YS42ENV^^1^
"BLD",19324,"KRN",9.8,"NM",283,0)
YS43POST^^1^
"BLD",19324,"KRN",9.8,"NM",284,0)
YS96POST^^1^
"BLD",19324,"KRN",9.8,"NM",285,0)
YS97POST^^1^
"BLD",19324,"KRN",9.8,"NM",286,0)
YSANTEG^^1^
"BLD",19324,"KRN",9.8,"NM",287,0)
YSAPOST^^1^
"BLD",19324,"KRN",9.8,"NM",288,0)
YS501100^^1^
"BLD",19324,"KRN",9.8,"NM",289,0)
YS501P82^^1^
"BLD",19324,"KRN",9.8,"NM",290,0)
YS501P83^^1^
"BLD",19324,"KRN",9.8,"NM",291,0)
YTRPWRP^^0^B16819326
"BLD",19324,"KRN",9.8,"NM",292,0)
YSXRAF^^1^
"BLD",19324,"KRN",9.8,"NM",293,0)
YSXRAF1^^1^
"BLD",19324,"KRN",9.8,"NM",294,0)
YSXRAF2^^1^
"BLD",19324,"KRN",9.8,"NM",295,0)
YSXRAF3^^1^
"BLD",19324,"KRN",9.8,"NM",296,0)
YSXRAF4^^1^
"BLD",19324,"KRN",9.8,"NM",297,0)
YSXRAF5^^1^
"BLD",19324,"KRN",9.8,"NM",298,0)
YSXRAF6^^1^
"BLD",19324,"KRN",9.8,"NM","B","YS03ENV",264)

"BLD",19324,"KRN",9.8,"NM","B","YS04ENV",265)

"BLD",19324,"KRN",9.8,"NM","B","YS04POST",266)

"BLD",19324,"KRN",9.8,"NM","B","YS05ENV",267)

"BLD",19324,"KRN",9.8,"NM","B","YS05POST",224)

"BLD",19324,"KRN",9.8,"NM","B","YS06ENV",36)

"BLD",19324,"KRN",9.8,"NM","B","YS23ENV",268)

"BLD",19324,"KRN",9.8,"NM","B","YS23POST",269)

"BLD",19324,"KRN",9.8,"NM","B","YS24ENV",270)

"BLD",19324,"KRN",9.8,"NM","B","YS24POST",271)

"BLD",19324,"KRN",9.8,"NM","B","YS26ENV",272)

"BLD",19324,"KRN",9.8,"NM","B","YS29ENV",273)

"BLD",19324,"KRN",9.8,"NM","B","YS30ENV",274)

"BLD",19324,"KRN",9.8,"NM","B","YS30PRE",275)

"BLD",19324,"KRN",9.8,"NM","B","YS32ENV",276)

"BLD",19324,"KRN",9.8,"NM","B","YS33ENV",277)

"BLD",19324,"KRN",9.8,"NM","B","YS37ENV",278)

"BLD",19324,"KRN",9.8,"NM","B","YS38ENV",279)

"BLD",19324,"KRN",9.8,"NM","B","YS38POST",280)

"BLD",19324,"KRN",9.8,"NM","B","YS39POST",281)

"BLD",19324,"KRN",9.8,"NM","B","YS42ENV",282)

"BLD",19324,"KRN",9.8,"NM","B","YS43POST",283)

"BLD",19324,"KRN",9.8,"NM","B","YS501100",288)

"BLD",19324,"KRN",9.8,"NM","B","YS501P82",289)

"BLD",19324,"KRN",9.8,"NM","B","YS501P83",290)

"BLD",19324,"KRN",9.8,"NM","B","YS85POST",157)

"BLD",19324,"KRN",9.8,"NM","B","YS85PRE",158)

"BLD",19324,"KRN",9.8,"NM","B","YS96POST",284)

"BLD",19324,"KRN",9.8,"NM","B","YS97POST",285)

"BLD",19324,"KRN",9.8,"NM","B","YSANTEG",286)

"BLD",19324,"KRN",9.8,"NM","B","YSAPOST",287)

"BLD",19324,"KRN",9.8,"NM","B","YSASCF",1)

"BLD",19324,"KRN",9.8,"NM","B","YSASNAR",252)

"BLD",19324,"KRN",9.8,"NM","B","YSASPNT",236)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN",2)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN1",3)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN10",4)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN13",5)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN14",6)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN2",7)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN21",8)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN22",9)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN23",10)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN24",11)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN26",12)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN3",13)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN31",14)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN32",15)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN33",16)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN34",17)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN35",18)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN36",19)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN37",20)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN39",21)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN4",22)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN41",23)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN5",24)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN51",25)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN52",26)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN53",27)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN54",28)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN55",29)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN56",30)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN6",31)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN61",32)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN7",33)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN8",34)

"BLD",19324,"KRN",9.8,"NM","B","YSCEN81",35)

"BLD",19324,"KRN",9.8,"NM","B","YSCPAF",159)

"BLD",19324,"KRN",9.8,"NM","B","YSCPAG",160)

"BLD",19324,"KRN",9.8,"NM","B","YSCPAI",161)

"BLD",19324,"KRN",9.8,"NM","B","YSCPAK",162)

"BLD",19324,"KRN",9.8,"NM","B","YSCPAL",163)

"BLD",19324,"KRN",9.8,"NM","B","YSCPAM",164)

"BLD",19324,"KRN",9.8,"NM","B","YSCPAQ",165)

"BLD",19324,"KRN",9.8,"NM","B","YSCUP",37)

"BLD",19324,"KRN",9.8,"NM","B","YSCUP000",38)

"BLD",19324,"KRN",9.8,"NM","B","YSCUP001",39)

"BLD",19324,"KRN",9.8,"NM","B","YSCUP002",40)

"BLD",19324,"KRN",9.8,"NM","B","YSCUP003",41)

"BLD",19324,"KRN",9.8,"NM","B","YSCUP004",42)

"BLD",19324,"KRN",9.8,"NM","B","YSD40030",166)

"BLD",19324,"KRN",9.8,"NM","B","YSD40031",167)

"BLD",19324,"KRN",9.8,"NM","B","YSD40032",168)

"BLD",19324,"KRN",9.8,"NM","B","YSD40040",169)

"BLD",19324,"KRN",9.8,"NM","B","YSD40041",170)

"BLD",19324,"KRN",9.8,"NM","B","YSD40042",171)

"BLD",19324,"KRN",9.8,"NM","B","YSD40050",172)

"BLD",19324,"KRN",9.8,"NM","B","YSD40051",173)

"BLD",19324,"KRN",9.8,"NM","B","YSD40052",174)

"BLD",19324,"KRN",9.8,"NM","B","YSD40060",175)

"BLD",19324,"KRN",9.8,"NM","B","YSD40061",176)

"BLD",19324,"KRN",9.8,"NM","B","YSD40062",177)

"BLD",19324,"KRN",9.8,"NM","B","YSD4C000",178)

"BLD",19324,"KRN",9.8,"NM","B","YSD4CK00",179)

"BLD",19324,"KRN",9.8,"NM","B","YSD4DSM",180)

"BLD",19324,"KRN",9.8,"NM","B","YSD4E010",181)

"BLD",19324,"KRN",9.8,"NM","B","YSD4E020",182)

"BLD",19324,"KRN",9.8,"NM","B","YSD4POS0",183)

"BLD",19324,"KRN",9.8,"NM","B","YSD4POST",223)

"BLD",19324,"KRN",9.8,"NM","B","YSD4PRE",184)

"BLD",19324,"KRN",9.8,"NM","B","YSD4PRE0",260)

"BLD",19324,"KRN",9.8,"NM","B","YSD4UT01",185)

"BLD",19324,"KRN",9.8,"NM","B","YSDX0001",226)

"BLD",19324,"KRN",9.8,"NM","B","YSDX0002",227)

"BLD",19324,"KRN",9.8,"NM","B","YSDX3",228)

"BLD",19324,"KRN",9.8,"NM","B","YSDX3UA",234)

"BLD",19324,"KRN",9.8,"NM","B","YSDXR",229)

"BLD",19324,"KRN",9.8,"NM","B","YSDXR000",230)

"BLD",19324,"KRN",9.8,"NM","B","YSDXR1",231)

"BLD",19324,"KRN",9.8,"NM","B","YSEMSG",43)

"BLD",19324,"KRN",9.8,"NM","B","YSESA",44)

"BLD",19324,"KRN",9.8,"NM","B","YSESD",45)

"BLD",19324,"KRN",9.8,"NM","B","YSESE",46)

"BLD",19324,"KRN",9.8,"NM","B","YSESED",47)

"BLD",19324,"KRN",9.8,"NM","B","YSESH",48)

"BLD",19324,"KRN",9.8,"NM","B","YSESL",49)

"BLD",19324,"KRN",9.8,"NM","B","YSESLOG",50)

"BLD",19324,"KRN",9.8,"NM","B","YSESM",51)

"BLD",19324,"KRN",9.8,"NM","B","YSESN",52)

"BLD",19324,"KRN",9.8,"NM","B","YSESP",53)

"BLD",19324,"KRN",9.8,"NM","B","YSESR",54)

"BLD",19324,"KRN",9.8,"NM","B","YSESUT",55)

"BLD",19324,"KRN",9.8,"NM","B","YSGAF3",56)

"BLD",19324,"KRN",9.8,"NM","B","YSHELP",57)

"BLD",19324,"KRN",9.8,"NM","B","YSHX1",186)

"BLD",19324,"KRN",9.8,"NM","B","YSHX1R",187)

"BLD",19324,"KRN",9.8,"NM","B","YSJOB",58)

"BLD",19324,"KRN",9.8,"NM","B","YSJOBK",59)

"BLD",19324,"KRN",9.8,"NM","B","YSKFASI1",188)

"BLD",19324,"KRN",9.8,"NM","B","YSKFASI2",189)

"BLD",19324,"KRN",9.8,"NM","B","YSKFASIF",190)

"BLD",19324,"KRN",9.8,"NM","B","YSKFASIM",60)

"BLD",19324,"KRN",9.8,"NM","B","YSLOCN",238)

"BLD",19324,"KRN",9.8,"NM","B","YSLRP",251)

"BLD",19324,"KRN",9.8,"NM","B","YSMHMENU",253)

"BLD",19324,"KRN",9.8,"NM","B","YSMV",191)

"BLD",19324,"KRN",9.8,"NM","B","YSMV1",192)

"BLD",19324,"KRN",9.8,"NM","B","YSNTEG",261)

"BLD",19324,"KRN",9.8,"NM","B","YSNTEG0",263)

"BLD",19324,"KRN",9.8,"NM","B","YSONIT",193)

"BLD",19324,"KRN",9.8,"NM","B","YSONIT1",194)

"BLD",19324,"KRN",9.8,"NM","B","YSONIT2",195)

"BLD",19324,"KRN",9.8,"NM","B","YSONIT3",196)

"BLD",19324,"KRN",9.8,"NM","B","YSPDR1",232)

"BLD",19324,"KRN",9.8,"NM","B","YSPDXR",233)

"BLD",19324,"KRN",9.8,"NM","B","YSPHY",61)

"BLD",19324,"KRN",9.8,"NM","B","YSPHY1",62)

"BLD",19324,"KRN",9.8,"NM","B","YSPHYR",63)

"BLD",19324,"KRN",9.8,"NM","B","YSPP",64)

"BLD",19324,"KRN",9.8,"NM","B","YSPP1",65)

"BLD",19324,"KRN",9.8,"NM","B","YSPP1A",262)

"BLD",19324,"KRN",9.8,"NM","B","YSPP2",66)

"BLD",19324,"KRN",9.8,"NM","B","YSPP3",67)

"BLD",19324,"KRN",9.8,"NM","B","YSPP4",68)

"BLD",19324,"KRN",9.8,"NM","B","YSPP5",69)

"BLD",19324,"KRN",9.8,"NM","B","YSPP6",70)

"BLD",19324,"KRN",9.8,"NM","B","YSPP7",71)

"BLD",19324,"KRN",9.8,"NM","B","YSPP8",72)

"BLD",19324,"KRN",9.8,"NM","B","YSPP9",73)

"BLD",19324,"KRN",9.8,"NM","B","YSPPJ",74)

"BLD",19324,"KRN",9.8,"NM","B","YSPRBR1",75)

"BLD",19324,"KRN",9.8,"NM","B","YSPRBR2",76)

"BLD",19324,"KRN",9.8,"NM","B","YSPROB",77)

"BLD",19324,"KRN",9.8,"NM","B","YSPROB1",78)

"BLD",19324,"KRN",9.8,"NM","B","YSPROB2",79)

"BLD",19324,"KRN",9.8,"NM","B","YSPROB3",80)

"BLD",19324,"KRN",9.8,"NM","B","YSPROB4",81)

"BLD",19324,"KRN",9.8,"NM","B","YSPROB5",82)

"BLD",19324,"KRN",9.8,"NM","B","YSPROBR",83)

"BLD",19324,"KRN",9.8,"NM","B","YSPROBR1",84)

"BLD",19324,"KRN",9.8,"NM","B","YSPROSE",85)

"BLD",19324,"KRN",9.8,"NM","B","YSPTX",86)

"BLD",19324,"KRN",9.8,"NM","B","YSPTX1",87)

"BLD",19324,"KRN",9.8,"NM","B","YSPTXR",88)

"BLD",19324,"KRN",9.8,"NM","B","YSSITE",222)

"BLD",19324,"KRN",9.8,"NM","B","YSSR",256)

"BLD",19324,"KRN",9.8,"NM","B","YSSR1",257)

"BLD",19324,"KRN",9.8,"NM","B","YSSR2",258)

"BLD",19324,"KRN",9.8,"NM","B","YSSRU",259)

"BLD",19324,"KRN",9.8,"NM","B","YSWX",89)

"BLD",19324,"KRN",9.8,"NM","B","YSWX1",90)

"BLD",19324,"KRN",9.8,"NM","B","YSWZ",91)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAF",292)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAF1",293)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAF2",294)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAF3",295)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAF4",296)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAF5",297)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAF6",298)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAG",97)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAG1",98)

"BLD",19324,"KRN",9.8,"NM","B","YSXRAG2",99)

"BLD",19324,"KRN",9.8,"NM","B","YSXRBA",129)

"BLD",19324,"KRN",9.8,"NM","B","YSXRBA1",130)

"BLD",19324,"KRN",9.8,"NM","B","YSXRBA2",131)

"BLD",19324,"KRN",9.8,"NM","B","YSXRBA3",132)

"BLD",19324,"KRN",9.8,"NM","B","YSXRBA4",133)

"BLD",19324,"KRN",9.8,"NM","B","YSXRBA5",134)

"BLD",19324,"KRN",9.8,"NM","B","YSXRBA6",135)

"BLD",19324,"KRN",9.8,"NM","B","YTAPI7",242)

"BLD",19324,"KRN",9.8,"NM","B","YTEX",254)

"BLD",19324,"KRN",9.8,"NM","B","YTMCMI2B",220)

"BLD",19324,"KRN",9.8,"NM","B","YTMCMI2C",221)

"BLD",19324,"KRN",9.8,"NM","B","YTMMPI2",240)

"BLD",19324,"KRN",9.8,"NM","B","YTONLY",243)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI001",136)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI002",137)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI003",138)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI004",139)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI005",140)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI006",141)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI007",142)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI008",143)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI009",144)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00A",145)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00B",146)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00C",147)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00D",148)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00E",149)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00F",150)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00G",151)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00H",152)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00I",153)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00J",154)

"BLD",19324,"KRN",9.8,"NM","B","YTQQI00K",155)

"BLD",19324,"KRN",9.8,"NM","B","YTRPWRP",291)

"BLD",19324,"KRN",9.8,"NM","B","YTS",156)

"BLD",19324,"KRN",9.8,"NM","B","YTTB",255)

"BLD",19324,"KRN",19,0)
19
"BLD",19324,"KRN",19,"NM",0)
^9.68A^90^89
"BLD",19324,"KRN",19,"NM",1,0)
YS SITE-FILE 16^^1^
"BLD",19324,"KRN",19,"NM",2,0)
YS SITE-FILE 602 WWU^^1^
"BLD",19324,"KRN",19,"NM",3,0)
YSAPROB^^1^
"BLD",19324,"KRN",19,"NM",4,0)
YSAS CASE FINDER^^1^
"BLD",19324,"KRN",19,"NM",5,0)
YSAS FOLLOWUP FINDER^^1^
"BLD",19324,"KRN",19,"NM",6,0)
YSCENCAD^^1^
"BLD",19324,"KRN",19,"NM",7,0)
YSCENCL^^1^
"BLD",19324,"KRN",19,"NM",8,0)
YSCENCRISIS^^1^
"BLD",19324,"KRN",19,"NM",9,0)
YSCENDAYHX^^1^
"BLD",19324,"KRN",19,"NM",10,0)
YSCENDCDOC^^1^
"BLD",19324,"KRN",19,"NM",11,0)
YSCENDIA^^1^
"BLD",19324,"KRN",19,"NM",12,0)
YSCENED^^1^
"BLD",19324,"KRN",19,"NM",13,0)
YSCENEDM^^1^
"BLD",19324,"KRN",19,"NM",14,0)
YSCENFS^^1^
"BLD",19324,"KRN",19,"NM",15,0)
YSCENGED^^1^
"BLD",19324,"KRN",19,"NM",16,0)
YSCENIL^^1^
"BLD",19324,"KRN",19,"NM",17,0)
YSCENLOS^^1^
"BLD",19324,"KRN",19,"NM",18,0)
YSCENMAIN^^1^
"BLD",19324,"KRN",19,"NM",19,0)
YSCENMEDS^^1^
"BLD",19324,"KRN",19,"NM",20,0)
YSCENMGR^^1^
"BLD",19324,"KRN",19,"NM",21,0)
YSCENNAM^^1^
"BLD",19324,"KRN",19,"NM",22,0)
YSCENNEW^^1^
"BLD",19324,"KRN",19,"NM",23,0)
YSCENPAHX^^1^
"BLD",19324,"KRN",19,"NM",24,0)
YSCENPASS^^1^
"BLD",19324,"KRN",19,"NM",25,0)
YSCENPL^^1^
"BLD",19324,"KRN",19,"NM",26,0)
YSCENPP^^1^
"BLD",19324,"KRN",19,"NM",27,0)
YSCENREM^^1^
"BLD",19324,"KRN",19,"NM",28,0)
YSCENROT^^1^
"BLD",19324,"KRN",19,"NM",29,0)
YSCENSL^^1^
"BLD",19324,"KRN",19,"NM",30,0)
YSCENSUBUP^^1^
"BLD",19324,"KRN",19,"NM",31,0)
YSCENTAH^^1^
"BLD",19324,"KRN",19,"NM",32,0)
YSCENTCEN^^1^
"BLD",19324,"KRN",19,"NM",33,0)
YSCENTESTING^^1^
"BLD",19324,"KRN",19,"NM",34,0)
YSCENTMHX^^1^
"BLD",19324,"KRN",19,"NM",35,0)
YSCENTPTE^^1^
"BLD",19324,"KRN",19,"NM",36,0)
YSCENTPTP^^1^
"BLD",19324,"KRN",19,"NM",37,0)
YSCENUNITUP^^1^
"BLD",19324,"KRN",19,"NM",38,0)
YSCENUNT^^1^
"BLD",19324,"KRN",19,"NM",39,0)
YSCENWDM^^1^
"BLD",19324,"KRN",19,"NM",40,0)
YSCENWL^^1^
"BLD",19324,"KRN",19,"NM",41,0)
YSCRISNOT^^1^
"BLD",19324,"KRN",19,"NM",42,0)
YSDECTREES-R^^1^
"BLD",19324,"KRN",19,"NM",43,0)
YSEPROB^^1^
"BLD",19324,"KRN",19,"NM",44,0)
YSFPROB^^1^
"BLD",19324,"KRN",19,"NM",45,0)
YSGAF CASE FINDER^^1^
"BLD",19324,"KRN",19,"NM",46,0)
YSHX1^^1^
"BLD",19324,"KRN",19,"NM",47,0)
YSIPROB^^1^
"BLD",19324,"KRN",19,"NM",48,0)
YSJOBINQ^^1^
"BLD",19324,"KRN",19,"NM",49,0)
YSJOBKILL^^1^
"BLD",19324,"KRN",19,"NM",50,0)
YSJOBLIST^^1^
"BLD",19324,"KRN",19,"NM",51,0)
YSJOBUPDATE^^1^
"BLD",19324,"KRN",19,"NM",52,0)
YSMOVP^^1^
"BLD",19324,"KRN",19,"NM",53,0)
YSPATMSG^^1^
"BLD",19324,"KRN",19,"NM",54,0)
YSPATPROF^^1^
"BLD",19324,"KRN",19,"NM",55,0)
YSPHYEXAM^^1^
"BLD",19324,"KRN",19,"NM",56,0)
YSPLDX^^1^
"BLD",19324,"KRN",19,"NM",57,0)
YSPLPDX^^1^
"BLD",19324,"KRN",19,"NM",58,0)
YSPPROB^^1^
"BLD",19324,"KRN",19,"NM",59,0)
YSPROBLIST^^1^
"BLD",19324,"KRN",19,"NM",60,0)
YSRAPROB^^1^
"BLD",19324,"KRN",19,"NM",61,0)
YSRFPROB^^1^
"BLD",19324,"KRN",19,"NM",62,0)
YSRSPROB^^1^
"BLD",19324,"KRN",19,"NM",63,0)
YSVOCATIONAL^^1^
"BLD",19324,"KRN",19,"NM",64,0)
YSWAITCR^^1^
"BLD",19324,"KRN",19,"NM",65,0)
YSWAITE^^1^
"BLD",19324,"KRN",19,"NM",66,0)
YSWAITEDI^^1^
"BLD",19324,"KRN",19,"NM",67,0)
YSWAITLST^^1^
"BLD",19324,"KRN",19,"NM",68,0)
YSWAITP^^1^
"BLD",19324,"KRN",19,"NM",69,0)
YSWAITREM^^1^
"BLD",19324,"KRN",19,"NM",70,0)
YSWAITSHUF^^1^
"BLD",19324,"KRN",19,"NM",71,0)
YSHXPASTR^^1^
"BLD",19324,"KRN",19,"NM",72,0)
YSPERSHXR^^1^
"BLD",19324,"KRN",19,"NM",73,0)
YSREVSYSR^^1^
"BLD",19324,"KRN",19,"NM",74,0)
YSPTINSTRU^^1^
"BLD",19324,"KRN",19,"NM",75,0)
YSPERSHX^^1^
"BLD",19324,"KRN",19,"NM",76,0)
YSREVSYS^^1^
"BLD",19324,"KRN",19,"NM",78,0)
YSMLST^^1^
"BLD",19324,"KRN",19,"NM",79,0)
YSCLERK^^1^
"BLD",19324,"KRN",19,"NM",80,0)
YSDIRTEST^^1^
"BLD",19324,"KRN",19,"NM",81,0)
YSCOMMENT^^1^
"BLD",19324,"KRN",19,"NM",82,0)
YSPRINT^^1^
"BLD",19324,"KRN",19,"NM",83,0)
YSMANAGEMENT^^1^
"BLD",19324,"KRN",19,"NM",84,0)
YS SITE-FILE 602 TEST LIM^^1^
"BLD",19324,"KRN",19,"NM",85,0)
YSINST RESTART LIMIT^^1^
"BLD",19324,"KRN",19,"NM",86,0)
YSEXTESTS^^1^
"BLD",19324,"KRN",19,"NM",87,0)
YSTESTBAT^^1^
"BLD",19324,"KRN",19,"NM",88,0)
YSADMTEST^^1^
"BLD",19324,"KRN",19,"NM",89,0)
YSHXPAST^^1^
"BLD",19324,"KRN",19,"NM",90,0)
YT SF36 HEALTH SURVEY^^1^
"BLD",19324,"KRN",19,"NM","B","YS SITE-FILE 16",1)

"BLD",19324,"KRN",19,"NM","B","YS SITE-FILE 602 TEST LIM",84)

"BLD",19324,"KRN",19,"NM","B","YS SITE-FILE 602 WWU",2)

"BLD",19324,"KRN",19,"NM","B","YSADMTEST",88)

"BLD",19324,"KRN",19,"NM","B","YSAPROB",3)

"BLD",19324,"KRN",19,"NM","B","YSAS CASE FINDER",4)

"BLD",19324,"KRN",19,"NM","B","YSAS FOLLOWUP FINDER",5)

"BLD",19324,"KRN",19,"NM","B","YSCENCAD",6)

"BLD",19324,"KRN",19,"NM","B","YSCENCL",7)

"BLD",19324,"KRN",19,"NM","B","YSCENCRISIS",8)

"BLD",19324,"KRN",19,"NM","B","YSCENDAYHX",9)

"BLD",19324,"KRN",19,"NM","B","YSCENDCDOC",10)

"BLD",19324,"KRN",19,"NM","B","YSCENDIA",11)

"BLD",19324,"KRN",19,"NM","B","YSCENED",12)

"BLD",19324,"KRN",19,"NM","B","YSCENEDM",13)

"BLD",19324,"KRN",19,"NM","B","YSCENFS",14)

"BLD",19324,"KRN",19,"NM","B","YSCENGED",15)

"BLD",19324,"KRN",19,"NM","B","YSCENIL",16)

"BLD",19324,"KRN",19,"NM","B","YSCENLOS",17)

"BLD",19324,"KRN",19,"NM","B","YSCENMAIN",18)

"BLD",19324,"KRN",19,"NM","B","YSCENMEDS",19)

"BLD",19324,"KRN",19,"NM","B","YSCENMGR",20)

"BLD",19324,"KRN",19,"NM","B","YSCENNAM",21)

"BLD",19324,"KRN",19,"NM","B","YSCENNEW",22)

"BLD",19324,"KRN",19,"NM","B","YSCENPAHX",23)

"BLD",19324,"KRN",19,"NM","B","YSCENPASS",24)

"BLD",19324,"KRN",19,"NM","B","YSCENPL",25)

"BLD",19324,"KRN",19,"NM","B","YSCENPP",26)

"BLD",19324,"KRN",19,"NM","B","YSCENREM",27)

"BLD",19324,"KRN",19,"NM","B","YSCENROT",28)

"BLD",19324,"KRN",19,"NM","B","YSCENSL",29)

"BLD",19324,"KRN",19,"NM","B","YSCENSUBUP",30)

"BLD",19324,"KRN",19,"NM","B","YSCENTAH",31)

"BLD",19324,"KRN",19,"NM","B","YSCENTCEN",32)

"BLD",19324,"KRN",19,"NM","B","YSCENTESTING",33)

"BLD",19324,"KRN",19,"NM","B","YSCENTMHX",34)

"BLD",19324,"KRN",19,"NM","B","YSCENTPTE",35)

"BLD",19324,"KRN",19,"NM","B","YSCENTPTP",36)

"BLD",19324,"KRN",19,"NM","B","YSCENUNITUP",37)

"BLD",19324,"KRN",19,"NM","B","YSCENUNT",38)

"BLD",19324,"KRN",19,"NM","B","YSCENWDM",39)

"BLD",19324,"KRN",19,"NM","B","YSCENWL",40)

"BLD",19324,"KRN",19,"NM","B","YSCLERK",79)

"BLD",19324,"KRN",19,"NM","B","YSCOMMENT",81)

"BLD",19324,"KRN",19,"NM","B","YSCRISNOT",41)

"BLD",19324,"KRN",19,"NM","B","YSDECTREES-R",42)

"BLD",19324,"KRN",19,"NM","B","YSDIRTEST",80)

"BLD",19324,"KRN",19,"NM","B","YSEPROB",43)

"BLD",19324,"KRN",19,"NM","B","YSEXTESTS",86)

"BLD",19324,"KRN",19,"NM","B","YSFPROB",44)

"BLD",19324,"KRN",19,"NM","B","YSGAF CASE FINDER",45)

"BLD",19324,"KRN",19,"NM","B","YSHX1",46)

"BLD",19324,"KRN",19,"NM","B","YSHXPAST",89)

"BLD",19324,"KRN",19,"NM","B","YSHXPASTR",71)

"BLD",19324,"KRN",19,"NM","B","YSINST RESTART LIMIT",85)

"BLD",19324,"KRN",19,"NM","B","YSIPROB",47)

"BLD",19324,"KRN",19,"NM","B","YSJOBINQ",48)

"BLD",19324,"KRN",19,"NM","B","YSJOBKILL",49)

"BLD",19324,"KRN",19,"NM","B","YSJOBLIST",50)

"BLD",19324,"KRN",19,"NM","B","YSJOBUPDATE",51)

"BLD",19324,"KRN",19,"NM","B","YSMANAGEMENT",83)

"BLD",19324,"KRN",19,"NM","B","YSMLST",78)

"BLD",19324,"KRN",19,"NM","B","YSMOVP",52)

"BLD",19324,"KRN",19,"NM","B","YSPATMSG",53)

"BLD",19324,"KRN",19,"NM","B","YSPATPROF",54)

"BLD",19324,"KRN",19,"NM","B","YSPERSHX",75)

"BLD",19324,"KRN",19,"NM","B","YSPERSHXR",72)

"BLD",19324,"KRN",19,"NM","B","YSPHYEXAM",55)

"BLD",19324,"KRN",19,"NM","B","YSPLDX",56)

"BLD",19324,"KRN",19,"NM","B","YSPLPDX",57)

"BLD",19324,"KRN",19,"NM","B","YSPPROB",58)

"BLD",19324,"KRN",19,"NM","B","YSPRINT",82)

"BLD",19324,"KRN",19,"NM","B","YSPROBLIST",59)

"BLD",19324,"KRN",19,"NM","B","YSPTINSTRU",74)

"BLD",19324,"KRN",19,"NM","B","YSRAPROB",60)

"BLD",19324,"KRN",19,"NM","B","YSREVSYS",76)

"BLD",19324,"KRN",19,"NM","B","YSREVSYSR",73)

"BLD",19324,"KRN",19,"NM","B","YSRFPROB",61)

"BLD",19324,"KRN",19,"NM","B","YSRSPROB",62)

"BLD",19324,"KRN",19,"NM","B","YSTESTBAT",87)

"BLD",19324,"KRN",19,"NM","B","YSVOCATIONAL",63)

"BLD",19324,"KRN",19,"NM","B","YSWAITCR",64)

"BLD",19324,"KRN",19,"NM","B","YSWAITE",65)

"BLD",19324,"KRN",19,"NM","B","YSWAITEDI",66)

"BLD",19324,"KRN",19,"NM","B","YSWAITLST",67)

"BLD",19324,"KRN",19,"NM","B","YSWAITP",68)

"BLD",19324,"KRN",19,"NM","B","YSWAITREM",69)

"BLD",19324,"KRN",19,"NM","B","YSWAITSHUF",70)

"BLD",19324,"KRN",19,"NM","B","YT SF36 HEALTH SURVEY",90)

"BLD",19324,"KRN",19.1,0)
19.1
"BLD",19324,"KRN",19.1,"NM",0)
^9.68A^^0
"BLD",19324,"KRN",101,0)
101
"BLD",19324,"KRN",101,"NM",0)
^9.68A^1^1
"BLD",19324,"KRN",101,"NM",1,0)
YS PATIENT MOVEMENT^^1^
"BLD",19324,"KRN",101,"NM","B","YS PATIENT MOVEMENT",1)

"BLD",19324,"KRN",409.61,0)
409.61
"BLD",19324,"KRN",771,0)
771
"BLD",19324,"KRN",779.2,0)
779.2
"BLD",19324,"KRN",870,0)
870
"BLD",19324,"KRN",8989.51,0)
8989.51
"BLD",19324,"KRN",8989.52,0)
8989.52
"BLD",19324,"KRN",8994,0)
8994
"BLD",19324,"KRN",8994,"NM",0)
^9.68A^17^17
"BLD",19324,"KRN",8994,"NM",1,0)
YTAPI CLERK RESPONSES^^0
"BLD",19324,"KRN",8994,"NM",2,0)
YTAPI GET INCOMPLETE^^0
"BLD",19324,"KRN",8994,"NM",3,0)
YTAPI LIST INCOMPLETES^^0
"BLD",19324,"KRN",8994,"NM",4,0)
YTAPI LISTALL^^0
"BLD",19324,"KRN",8994,"NM",5,0)
YTAPI LISTONE^^0
"BLD",19324,"KRN",8994,"NM",6,0)
YTAPI OUTNOTE^^0
"BLD",19324,"KRN",8994,"NM",7,0)
YTAPI PREVIEW^^0
"BLD",19324,"KRN",8994,"NM",8,0)
YTAPI PRIVLEGE^^0
"BLD",19324,"KRN",8994,"NM",9,0)
YTAPI QUEST^^0
"BLD",19324,"KRN",8994,"NM",10,0)
YTAPI SAVE INCOMPLETES^^0
"BLD",19324,"KRN",8994,"NM",11,0)
YTAPI SAVE TEST COMMENT^^0
"BLD",19324,"KRN",8994,"NM",12,0)
YTAPI SAVEIT^^0
"BLD",19324,"KRN",8994,"NM",13,0)
YTAPI SCOREIT^^0
"BLD",19324,"KRN",8994,"NM",14,0)
YTAPI SHOWALL^^0
"BLD",19324,"KRN",8994,"NM",15,0)
YTAPI TEST BATTERY^^0
"BLD",19324,"KRN",8994,"NM",16,0)
YTAPI TEST BULLETIN^^0
"BLD",19324,"KRN",8994,"NM",17,0)
YTAPI SHOWIT^^0
"BLD",19324,"KRN",8994,"NM","B","YTAPI CLERK RESPONSES",1)

"BLD",19324,"KRN",8994,"NM","B","YTAPI GET INCOMPLETE",2)

"BLD",19324,"KRN",8994,"NM","B","YTAPI LIST INCOMPLETES",3)

"BLD",19324,"KRN",8994,"NM","B","YTAPI LISTALL",4)

"BLD",19324,"KRN",8994,"NM","B","YTAPI LISTONE",5)

"BLD",19324,"KRN",8994,"NM","B","YTAPI OUTNOTE",6)

"BLD",19324,"KRN",8994,"NM","B","YTAPI PREVIEW",7)

"BLD",19324,"KRN",8994,"NM","B","YTAPI PRIVLEGE",8)

"BLD",19324,"KRN",8994,"NM","B","YTAPI QUEST",9)

"BLD",19324,"KRN",8994,"NM","B","YTAPI SAVE INCOMPLETES",10)

"BLD",19324,"KRN",8994,"NM","B","YTAPI SAVE TEST COMMENT",11)

"BLD",19324,"KRN",8994,"NM","B","YTAPI SAVEIT",12)

"BLD",19324,"KRN",8994,"NM","B","YTAPI SCOREIT",13)

"BLD",19324,"KRN",8994,"NM","B","YTAPI SHOWALL",14)

"BLD",19324,"KRN",8994,"NM","B","YTAPI SHOWIT",17)

"BLD",19324,"KRN",8994,"NM","B","YTAPI TEST BATTERY",15)

"BLD",19324,"KRN",8994,"NM","B","YTAPI TEST BULLETIN",16)

"BLD",19324,"KRN","B",.4,.4)

"BLD",19324,"KRN","B",.401,.401)

"BLD",19324,"KRN","B",.402,.402)

"BLD",19324,"KRN","B",.403,.403)

"BLD",19324,"KRN","B",.5,.5)

"BLD",19324,"KRN","B",.84,.84)

"BLD",19324,"KRN","B",3.6,3.6)

"BLD",19324,"KRN","B",3.8,3.8)

"BLD",19324,"KRN","B",9.2,9.2)

"BLD",19324,"KRN","B",9.8,9.8)

"BLD",19324,"KRN","B",19,19)

"BLD",19324,"KRN","B",19.1,19.1)

"BLD",19324,"KRN","B",101,101)

"BLD",19324,"KRN","B",409.61,409.61)

"BLD",19324,"KRN","B",771,771)

"BLD",19324,"KRN","B",779.2,779.2)

"BLD",19324,"KRN","B",870,870)

"BLD",19324,"KRN","B",8989.51,8989.51)

"BLD",19324,"KRN","B",8989.52,8989.52)

"BLD",19324,"KRN","B",8994,8994)

"BLD",19324,"QDEF")
^^^^NO^^^^YES^^NO
"BLD",19324,"QUES",0)
^9.62^^
"BLD",19324,"REQB",0)
^9.611^9^9
"BLD",19324,"REQB",1,0)
YS*5.01*88^2
"BLD",19324,"REQB",2,0)
YS*5.01*33^2
"BLD",19324,"REQB",3,0)
YS*5.01*96^2
"BLD",19324,"REQB",4,0)
YS*5.01*49^2
"BLD",19324,"REQB",5,0)
YS*5.01*70^2
"BLD",19324,"REQB",6,0)
YS*5.01*82^2
"BLD",19324,"REQB",7,0)
YS*5.01*106^2
"BLD",19324,"REQB",8,0)
YS*5.01*103^2
"BLD",19324,"REQB",9,0)
YS*5.01*52^2
"BLD",19324,"REQB","B","YS*5.01*103",8)

"BLD",19324,"REQB","B","YS*5.01*106",7)

"BLD",19324,"REQB","B","YS*5.01*33",2)

"BLD",19324,"REQB","B","YS*5.01*49",4)

"BLD",19324,"REQB","B","YS*5.01*52",9)

"BLD",19324,"REQB","B","YS*5.01*70",5)

"BLD",19324,"REQB","B","YS*5.01*82",6)

"BLD",19324,"REQB","B","YS*5.01*88",1)

"BLD",19324,"REQB","B","YS*5.01*96",3)

"INI")
YS60PRE
"INIT")
YS60POST
"KRN",.4,2161,-1)
1^1
"KRN",.4,2161,0)
YSJOB    FILE #624
"KRN",.402,2147,-1)
1^1
"KRN",.402,2147,0)
YSCEN UNIT DEF    FILE #618
"KRN",9.2,616,-1)
0^1
"KRN",9.2,616,0)
YS-PHY-EXAM-NORM^IS THE PHYSICAL EXAM NORMAL^2890413^
"KRN",9.2,616,1,0)
^^5^5^2890222^^^^
"KRN",9.2,616,1,1,0)
"NO" allows you to omit the system or enter an abnormal description
"KRN",9.2,616,1,2,0)
of the system.
"KRN",9.2,616,1,3,0)
    
"KRN",9.2,616,1,4,0)
"YES" automatically enters a "within normal limits" description of
"KRN",9.2,616,1,5,0)
the system.
"KRN",9.2,616,3,0)
^9.23A^1^1
"KRN",9.2,616,3,1,0)
YSDIZ
"KRN",19,13315,-1)
1^1
"KRN",19,13315,0)
YS SITE-FILE 16
"KRN",19,13316,-1)
1^2
"KRN",19,13316,0)
YS SITE-FILE 602 WWU
"KRN",19,13317,-1)
1^3
"KRN",19,13317,0)
YSAPROB
"KRN",19,13318,-1)
1^4
"KRN",19,13318,0)
YSAS CASE FINDER
"KRN",19,13319,-1)
1^5
"KRN",19,13319,0)
YSAS FOLLOWUP FINDER
"KRN",19,13320,-1)
1^6
"KRN",19,13320,0)
YSCENCAD
"KRN",19,13321,-1)
1^7
"KRN",19,13321,0)
YSCENCL
"KRN",19,13322,-1)
1^8
"KRN",19,13322,0)
YSCENCRISIS
"KRN",19,13323,-1)
1^9
"KRN",19,13323,0)
YSCENDAYHX
"KRN",19,13324,-1)
1^10
"KRN",19,13324,0)
YSCENDCDOC
"KRN",19,13325,-1)
1^11
"KRN",19,13325,0)
YSCENDIA
"KRN",19,13326,-1)
1^12
"KRN",19,13326,0)
YSCENED
"KRN",19,13327,-1)
1^13
"KRN",19,13327,0)
YSCENEDM
"KRN",19,13328,-1)
1^14
"KRN",19,13328,0)
YSCENFS
"KRN",19,13329,-1)
1^15
"KRN",19,13329,0)
YSCENGED
"KRN",19,13330,-1)
1^16
"KRN",19,13330,0)
YSCENIL
"KRN",19,13331,-1)
1^17
"KRN",19,13331,0)
YSCENLOS
"KRN",19,13332,-1)
1^18
"KRN",19,13332,0)
YSCENMAIN
"KRN",19,13333,-1)
1^19
"KRN",19,13333,0)
YSCENMEDS
"KRN",19,13334,-1)
1^20
"KRN",19,13334,0)
YSCENMGR
"KRN",19,13335,-1)
1^21
"KRN",19,13335,0)
YSCENNAM
"KRN",19,13336,-1)
1^22
"KRN",19,13336,0)
YSCENNEW
"KRN",19,13337,-1)
1^23
"KRN",19,13337,0)
YSCENPAHX
"KRN",19,13338,-1)
1^24
"KRN",19,13338,0)
YSCENPASS
"KRN",19,13339,-1)
1^25
"KRN",19,13339,0)
YSCENPL
"KRN",19,13340,-1)
1^26
"KRN",19,13340,0)
YSCENPP
"KRN",19,13341,-1)
1^27
"KRN",19,13341,0)
YSCENREM
"KRN",19,13342,-1)
1^28
"KRN",19,13342,0)
YSCENROT
"KRN",19,13343,-1)
1^29
"KRN",19,13343,0)
YSCENSL
"KRN",19,13344,-1)
1^30
"KRN",19,13344,0)
YSCENSUBUP
"KRN",19,13345,-1)
1^31
"KRN",19,13345,0)
YSCENTAH
"KRN",19,13346,-1)
1^32
"KRN",19,13346,0)
YSCENTCEN
"KRN",19,13347,-1)
1^33
"KRN",19,13347,0)
YSCENTESTING
"KRN",19,13348,-1)
1^34
"KRN",19,13348,0)
YSCENTMHX
"KRN",19,13349,-1)
1^35
"KRN",19,13349,0)
YSCENTPTE
"KRN",19,13350,-1)
1^36
"KRN",19,13350,0)
YSCENTPTP
"KRN",19,13351,-1)
1^37
"KRN",19,13351,0)
YSCENUNITUP
"KRN",19,13352,-1)
1^38
"KRN",19,13352,0)
YSCENUNT
"KRN",19,13353,-1)
1^39
"KRN",19,13353,0)
YSCENWDM
"KRN",19,13354,-1)
1^40
"KRN",19,13354,0)
YSCENWL
"KRN",19,13355,-1)
1^41
"KRN",19,13355,0)
YSCRISNOT
"KRN",19,13356,-1)
1^42
"KRN",19,13356,0)
YSDECTREES-R
"KRN",19,13357,-1)
1^43
"KRN",19,13357,0)
YSEPROB
"KRN",19,13358,-1)
1^44
"KRN",19,13358,0)
YSFPROB
"KRN",19,13359,-1)
1^45
"KRN",19,13359,0)
YSGAF CASE FINDER
"KRN",19,13360,-1)
1^46
"KRN",19,13360,0)
YSHX1
"KRN",19,13361,-1)
1^47
"KRN",19,13361,0)
YSIPROB
"KRN",19,13362,-1)
1^48
"KRN",19,13362,0)
YSJOBINQ
"KRN",19,13363,-1)
1^49
"KRN",19,13363,0)
YSJOBKILL
"KRN",19,13364,-1)
1^50
"KRN",19,13364,0)
YSJOBLIST
"KRN",19,13365,-1)
1^51
"KRN",19,13365,0)
YSJOBUPDATE
"KRN",19,13366,-1)
1^52
"KRN",19,13366,0)
YSMOVP
"KRN",19,13367,-1)
1^53
"KRN",19,13367,0)
YSPATMSG
"KRN",19,13368,-1)
1^54
"KRN",19,13368,0)
YSPATPROF
"KRN",19,13369,-1)
1^55
"KRN",19,13369,0)
YSPHYEXAM
"KRN",19,13370,-1)
1^56
"KRN",19,13370,0)
YSPLDX
"KRN",19,13371,-1)
1^57
"KRN",19,13371,0)
YSPLPDX
"KRN",19,13372,-1)
1^58
"KRN",19,13372,0)
YSPPROB
"KRN",19,13373,-1)
1^59
"KRN",19,13373,0)
YSPROBLIST
"KRN",19,13374,-1)
1^60
"KRN",19,13374,0)
YSRAPROB
"KRN",19,13375,-1)
1^61
"KRN",19,13375,0)
YSRFPROB
"KRN",19,13376,-1)
1^62
"KRN",19,13376,0)
YSRSPROB
"KRN",19,13377,-1)
1^63
"KRN",19,13377,0)
YSVOCATIONAL
"KRN",19,13378,-1)
1^64
"KRN",19,13378,0)
YSWAITCR
"KRN",19,13379,-1)
1^65
"KRN",19,13379,0)
YSWAITE
"KRN",19,13380,-1)
1^66
"KRN",19,13380,0)
YSWAITEDI
"KRN",19,13381,-1)
1^67
"KRN",19,13381,0)
YSWAITLST
"KRN",19,13382,-1)
1^68
"KRN",19,13382,0)
YSWAITP
"KRN",19,13383,-1)
1^69
"KRN",19,13383,0)
YSWAITREM
"KRN",19,13384,-1)
1^70
"KRN",19,13384,0)
YSWAITSHUF
"KRN",19,13385,-1)
1^71
"KRN",19,13385,0)
YSHXPASTR
"KRN",19,13386,-1)
1^72
"KRN",19,13386,0)
YSPERSHXR
"KRN",19,13387,-1)
1^73
"KRN",19,13387,0)
YSREVSYSR
"KRN",19,13388,-1)
1^74
"KRN",19,13388,0)
YSPTINSTRU
"KRN",19,13389,-1)
1^75
"KRN",19,13389,0)
YSPERSHX
"KRN",19,13390,-1)
1^76
"KRN",19,13390,0)
YSREVSYS
"KRN",19,13391,-1)
1^78
"KRN",19,13391,0)
YSMLST
"KRN",19,13392,-1)
1^79
"KRN",19,13392,0)
YSCLERK
"KRN",19,13393,-1)
1^80
"KRN",19,13393,0)
YSDIRTEST
"KRN",19,13394,-1)
1^81
"KRN",19,13394,0)
YSCOMMENT
"KRN",19,13395,-1)
1^82
"KRN",19,13395,0)
YSPRINT
"KRN",19,13396,-1)
1^83
"KRN",19,13396,0)
YSMANAGEMENT
"KRN",19,13397,-1)
1^84
"KRN",19,13397,0)
YS SITE-FILE 602 TEST LIM
"KRN",19,13398,-1)
1^85
"KRN",19,13398,0)
YSINST RESTART LIMIT
"KRN",19,13399,-1)
1^86
"KRN",19,13399,0)
YSEXTESTS
"KRN",19,13400,-1)
1^87
"KRN",19,13400,0)
YSTESTBAT
"KRN",19,13401,-1)
1^88
"KRN",19,13401,0)
YSADMTEST
"KRN",19,13402,-1)
1^89
"KRN",19,13402,0)
YSHXPAST
"KRN",19,13403,-1)
1^90
"KRN",19,13403,0)
YT SF36 HEALTH SURVEY
"KRN",101,6267,-1)
1^1
"KRN",101,6267,0)
YS PATIENT MOVEMENT
"KRN",8994,632,-1)
0^4
"KRN",8994,632,0)
YTAPI LISTALL^LISTALL^YTAPI^2^A^1
"KRN",8994,632,1,0)
^^21^21^3020315^
"KRN",8994,632,1,1,0)
This API returns all psychological test administrations for a specified 
"KRN",8994,632,1,2,0)
patient during a specified time period. No scoring is returned. ASI s and 
"KRN",8994,632,1,3,0)
optionally GAF s are also returned.
"KRN",8994,632,1,4,0)
 
"KRN",8994,632,1,5,0)
Input: 
"KRN",8994,632,1,6,0)
                DFN : patient internal identifier
"KRN",8994,632,1,7,0)
                BEGIN: inclusive date in %DT acceptable format 
"KRN",8994,632,1,8,0)
(11/11/2011) to begin search [optional]
"KRN",8994,632,1,9,0)
                END: inclusive date in %DT acceptable format (11/11/2011) 
"KRN",8994,632,1,10,0)
to end search  [optional]
"KRN",8994,632,1,11,0)
                CODE: YS("CODE")="GAF" set to optionally return GAF 
"KRN",8994,632,1,12,0)
administrations 
"KRN",8994,632,1,13,0)
 
"KRN",8994,632,1,14,0)
Output:
"KRN",8994,632,1,15,0)
YSDATA(1)=[DATA]
"KRN",8994,632,1,16,0)
YSDATA(x)= internal administration date^external administration date^test 
"KRN",8994,632,1,17,0)
code 
"KRN",8994,632,1,18,0)
 
"KRN",8994,632,1,19,0)
Data is sorted in order of most recent administration to the oldest 
"KRN",8994,632,1,20,0)
administration. If no administrations are found YSDATA(2) will not be 
"KRN",8994,632,1,21,0)
returned.
"KRN",8994,633,-1)
0^5
"KRN",8994,633,0)
YTAPI LISTONE^LISTONE^YTAPI^2^A^1
"KRN",8994,633,1,0)
^8994.01^26^26^3020315^^
"KRN",8994,633,1,1,0)
This API returns all psychological test administrations for a specified 
"KRN",8994,633,1,2,0)
patient during a specified time period  for a specified test or 
"KRN",8994,633,1,3,0)
instrument. If a scale is also specified, scoring for that scale is 
"KRN",8994,633,1,4,0)
returned. User must have adequate privileges to receive this information 
"KRN",8994,633,1,5,0)
(i.e. often the YSP KEY). 
"KRN",8994,633,1,6,0)
 
"KRN",8994,633,1,7,0)
 
"KRN",8994,633,1,8,0)
Input:
"KRN",8994,633,1,9,0)
       DFN : patient internal identifier
"KRN",8994,633,1,10,0)
       CODE: Test code from file 601 including "ASI" and "GAF" 
"KRN",8994,633,1,11,0)
e.g. "CAGE", "BDI"
"KRN",8994,633,1,12,0)
       BEGIN: inclusive date in %DT acceptable format (11/11/2011) to
"KRN",8994,633,1,13,0)
begin search [optional]
"KRN",8994,633,1,14,0)
       END: inclusive date in %DT acceptable format (11/11/2011) 
"KRN",8994,633,1,15,0)
to end search  [optional]
"KRN",8994,633,1,16,0)
       LIMIT: constrains to the last N administrations [optional]
"KRN",8994,633,1,17,0)
       Scale: scale number from file 601 or 1-7 on ASI [optional]
"KRN",8994,633,1,18,0)
Output:
"KRN",8994,633,1,19,0)
YSDATA(1)=[DATA]
"KRN",8994,633,1,20,0)
YSDATA(x)= internal administration date ^ external administration
"KRN",8994,633,1,21,0)
date^test code [^scale name^raw score^transformed score]
"KRN",8994,633,1,22,0)
 
"KRN",8994,633,1,23,0)
Data is sorted in order of most recent administration to the oldest 
"KRN",8994,633,1,24,0)
administration. If no administrations are found Array(2) will not be 
"KRN",8994,633,1,25,0)
returned. If patient has no psych testing at all ,an error will be 
"KRN",8994,633,1,26,0)
returned.
"KRN",8994,634,-1)
0^13
"KRN",8994,634,0)
YTAPI SCOREIT^SCOREIT^YTAPI2^2^A^1
"KRN",8994,634,1,0)
^8994.01^19^19^3020315^^
"KRN",8994,634,1,1,0)
This API returns all scoring information for a specified patient given a 
"KRN",8994,634,1,2,0)
specified administration date for a specified test or instrument.  User 
"KRN",8994,634,1,3,0)
must have adequate privileges to receive this information (i.e. often the 
"KRN",8994,634,1,4,0)
YSP KEY)
"KRN",8994,634,1,5,0)
 
"KRN",8994,634,1,6,0)
Input: 
"KRN",8994,634,1,7,0)
                DFN : patient internal identifier
"KRN",8994,634,1,8,0)
                CODE: Test code from file 601 or "ASI" e.g. "CAGE", "BDI"
"KRN",8994,634,1,9,0)
ADATE: inclusive administration date in %DT acceptable format (11/11/2011)
"KRN",8994,634,1,10,0)
 
"KRN",8994,634,1,11,0)
Output:
"KRN",8994,634,1,12,0)
Array(2)= Patient Name^Test Code^Test Title^Internal Admin date^External 
"KRN",8994,634,1,13,0)
Admin Date ^Ordered by
"KRN",8994,634,1,14,0)
Array(3)=R1^Responses 1-200 undelimited
"KRN",8994,634,1,15,0)
Array(4)=R2^ Responses 201-400 undelimited (even if less than 200)
"KRN",8994,634,1,16,0)
Array(5)=R3^ Responses 401-600 undelimited
"KRN",8994,634,1,17,0)
Array(6)=S1^Scale Name^Raw Score^Transformed Score
"KRN",8994,634,1,18,0)
Array(7)=S2^ Scale Name^Raw Score^Transformed Score
"KRN",8994,634,1,19,0)
   And onward as needed
"KRN",8994,635,-1)
0^12
"KRN",8994,635,0)
YTAPI SAVEIT^SAVEIT^YTAPI1^2^A^1
"KRN",8994,635,1,0)
^8994.01^17^17^3020315^^
"KRN",8994,635,1,1,0)
This API allows saving of patient responses to a test or interview in the 
"KRN",8994,635,1,2,0)
M database. The patient ien, the test code, and administration date is 
"KRN",8994,635,1,3,0)
required along with the responses. All responses are checked for 
"KRN",8994,635,1,4,0)
validity. No scoring is returned but successful addition to the M 
"KRN",8994,635,1,5,0)
database is indicated.
"KRN",8994,635,1,6,0)
 
"KRN",8994,635,1,7,0)
Input: 
"KRN",8994,635,1,8,0)
                DFN : patient internal identifier
"KRN",8994,635,1,9,0)
                CODE: Test code from file 601 or "ASI" e.g. "CAGE", "BDI"
"KRN",8994,635,1,10,0)
ADATE: inclusive administration date in %DT acceptable format (11/11/2011)
"KRN",8994,635,1,11,0)
                Staff: DUZ of professional ordering the test
"KRN",8994,635,1,12,0)
R1: string of patient responses 1-200
"KRN",8994,635,1,13,0)
                R2: string of patient responses 201-400 [as needed]
"KRN",8994,635,1,14,0)
                R3: string of patient responses 401-600 [as needed]
"KRN",8994,635,1,15,0)
 
"KRN",8994,635,1,16,0)
Output:
"KRN",8994,635,1,17,0)
Array(1)=[DATA] indicates successful  call
"KRN",8994,636,-1)
0^17
"KRN",8994,636,0)
YTAPI SHOWIT^SHOWIT^YTAPI3^2^A^1
"KRN",8994,636,1,0)
^^16^16^3020315^
"KRN",8994,636,1,1,0)
This API returns the text, bottom, introduction and possible correct 
"KRN",8994,636,1,2,0)
responses for a specified test item in file 601. It will work only for 
"KRN",8994,636,1,3,0)
tests as opposed to interviews or batteries. The ASI is not supported.
"KRN",8994,636,1,4,0)
 
"KRN",8994,636,1,5,0)
Input: 
"KRN",8994,636,1,6,0)
                CODE: Test code from file 601 e.g. "CAGE", "BDI"
"KRN",8994,636,1,7,0)
ITEM: a positive whole number between 1 and the highest item number for 
"KRN",8994,636,1,8,0)
the specified test.
"KRN",8994,636,1,9,0)
 
"KRN",8994,636,1,10,0)
Output:
"KRN",8994,636,1,11,0)
Array(1)=[DATA] ;indicates successful  call
"KRN",8994,636,1,12,0)
Array(2)=MMPI2^1 ;SECOND LINE IS TEST Code^ item number
"KRN",8994,636,1,13,0)
Array(item number,"I",line number)=introductory text
"KRN",8994,636,1,14,0)
Array(item number,"T", line number)=text of question
"KRN",8994,636,1,15,0)
Array(item number,"R",0)=allowed responses
"KRN",8994,636,1,16,0)
Array(item number,"R",line number)= response cues
"KRN",8994,637,-1)
0^14
"KRN",8994,637,0)
YTAPI SHOWALL^SHOWALL^YTAPI3^2^A^1
"KRN",8994,637,1,0)
^^14^14^3020315^
"KRN",8994,637,1,1,0)
This API returns the text, bottom, introduction and possible correct 
"KRN",8994,637,1,2,0)
responses for all items in a test in file 601. It will work only for 
"KRN",8994,637,1,3,0)
tests as opposed to interviews or batteries. The ASI is not supported.
"KRN",8994,637,1,4,0)
 
"KRN",8994,637,1,5,0)
Input: 
"KRN",8994,637,1,6,0)
                CODE: Test code from file 601 e.g. "CAGE", "BDI"
"KRN",8994,637,1,7,0)
 
"KRN",8994,637,1,8,0)
Output:
"KRN",8994,637,1,9,0)
Array(1)=[DATA] ;indicates successful  call
"KRN",8994,637,1,10,0)
Array(2)=MMPI2 ;SECOND LINE IS TEST Code
"KRN",8994,637,1,11,0)
Array(item number,"I",line number)=introductory text
"KRN",8994,637,1,12,0)
Array(item number,"T", line number)=text of question
"KRN",8994,637,1,13,0)
Array(item number,"R",0)=allowed responses
"KRN",8994,637,1,14,0)
Array(item number,"R",line number)= response cues
"KRN",8994,652,-1)
0^7
"KRN",8994,652,0)
YTAPI PREVIEW^PREVIEW^YTAPI4^2^A^1
"KRN",8994,652,1,0)
^8994.01^24^24^3020315^^^
"KRN",8994,652,1,1,0)
This API allows scoring of patient responses to a test or interview 
"KRN",8994,652,1,2,0)
without making changes in the  M database. The patient ien, the test 
"KRN",8994,652,1,3,0)
code, and administration date is required along with the responses. All 
"KRN",8994,652,1,4,0)
responses are checked for validity. Scoring is returned in the output 
"KRN",8994,652,1,5,0)
documented  in the SCOREIT API.
"KRN",8994,652,1,6,0)
 
"KRN",8994,652,1,7,0)
Input: 
"KRN",8994,652,1,8,0)
                DFN : patient internal identifier
"KRN",8994,652,1,9,0)
                CODE: Test code from file 601 or "ASI" e.g. "CAGE", "BDI"
"KRN",8994,652,1,10,0)
ADATE: inclusive administration date in %DT acceptable format (11/11/2011)
"KRN",8994,652,1,11,0)
                Staff: DUZ of professional ordering the test
"KRN",8994,652,1,12,0)
R1: string of patient responses 1-200
"KRN",8994,652,1,13,0)
                R2: string of patient responses 201-400 [as needed]
"KRN",8994,652,1,14,0)
                R3: string of patient responses 401-600 [as needed]
"KRN",8994,652,1,15,0)
 
"KRN",8994,652,1,16,0)
Output:
"KRN",8994,652,1,17,0)
Array(2)= Patient Name^Test Code^Test Title^Internal Admin date^External 
"KRN",8994,652,1,18,0)
Admin Date ^Ordered by
"KRN",8994,652,1,19,0)
Array(3)=R1^Responses 1-200 undelimited
"KRN",8994,652,1,20,0)
Array(4)=R2^ Responses 201-400 undelimited (even if less than 200)
"KRN",8994,652,1,21,0)
Array(5)=R3^ Responses 401-600 undelimited
"KRN",8994,652,1,22,0)
Array(6)=S1^Scale Name^Raw Score^Transformed Score
"KRN",8994,652,1,23,0)
Array(7)=S2^ Scale Name^Raw Score^Transformed Score
"KRN",8994,652,1,24,0)
   And onward as needed
"KRN",8994,653,-1)
0^6
"KRN",8994,653,0)
YTAPI OUTNOTE^OUTNOTE^YTAPI5^2^A^1
"KRN",8994,653,1,0)
^8994.01^25^25^3020315^^
"KRN",8994,653,1,1,0)
This API returns text to be entered in a progress note based on the 
"KRN",8994,653,1,2,0)
outcome of a test administration. Input is the output of  SCOREIT or 
"KRN",8994,653,1,3,0)
PREVIEW API. Output adds this text to the output YSDATA
"KRN",8994,653,1,4,0)
 
"KRN",8994,653,1,5,0)
Input: 
"KRN",8994,653,1,6,0)
Array(2)= Patient Name^Test Code^Test Title^Internal Admin date^External 
"KRN",8994,653,1,7,0)
Admin Date ^Ordered by
"KRN",8994,653,1,8,0)
Array(3)=R1^Responses 1-200 undelimited
"KRN",8994,653,1,9,0)
Array(4)=R2^ Responses 201-400 undelimited (even if less than 200)
"KRN",8994,653,1,10,0)
Array(5)=R3^ Responses 401-600 undelimited
"KRN",8994,653,1,11,0)
Array(6)=S1^Scale Name^Raw Score^Transformed Score
"KRN",8994,653,1,12,0)
Array(7)=S2^ Scale Name^Raw Score^Transformed Score
"KRN",8994,653,1,13,0)
   And onward as needed
"KRN",8994,653,1,14,0)
 
"KRN",8994,653,1,15,0)
 
"KRN",8994,653,1,16,0)
Output:
"KRN",8994,653,1,17,0)
Array(2)= Patient Name^Test Code^Test Title^Internal Admin date^External 
"KRN",8994,653,1,18,0)
Admin Date ^Ordered by
"KRN",8994,653,1,19,0)
Array(3)=R1^Responses 1-200 undelimited
"KRN",8994,653,1,20,0)
Array(4)=R2^ Responses 201-400 undelimited (even if less than 200)
"KRN",8994,653,1,21,0)
Array(5)=R3^ Responses 401-600 undelimited
"KRN",8994,653,1,22,0)
Array(6)=S1^Scale Name^Raw Score^Transformed Score
"KRN",8994,653,1,23,0)
Array(7)=S2^ Scale Name^Raw Score^Transformed Score
"KRN",8994,653,1,24,0)
   And onward as needed
"KRN",8994,653,1,25,0)
Array("ON")= output text
"KRN",8994,1296,-1)
0^9
"KRN",8994,1296,0)
YTAPI QUEST^QUEST^YTAPI6^2^R^1
"KRN",8994,1296,1,0)
^8994.01^21^21^3020315^^
"KRN",8994,1296,1,1,0)
Returns flat array with data about a psychological test.
"KRN",8994,1296,1,2,0)
This API returns the text, bottom, introduction and possible correct 
"KRN",8994,1296,1,3,0)
responses for all items in a test in file 601. It will work only for 
"KRN",8994,1296,1,4,0)
tests as opposed to interviews or batteries. The ASI is not supported.
"KRN",8994,1296,1,5,0)
 
"KRN",8994,1296,1,6,0)
Input: 
"KRN",8994,1296,1,7,0)
                CODE: Test code from file 601 e.g. "CAGE", "BDI"
"KRN",8994,1296,1,8,0)
 
"KRN",8994,1296,1,9,0)
Output:
"KRN",8994,1296,1,10,0)
Array(1)=[DATA] ;indicates successful  call
"KRN",8994,1296,1,11,0)
Array(2)=MMPI2 ;SECOND LINE IS TEST Code
"KRN",8994,1296,1,12,0)
Array(x)=first item number^I^introductory text
"KRN",8994,1296,1,13,0)
Array(x)=first item number^T^text of question
"KRN",8994,1296,1,14,0)
Array(x)=first item number^A^allowed responses
"KRN",8994,1296,1,15,0)
Array(x)= first item number^R^response cues
"KRN",8994,1296,1,16,0)
.
"KRN",8994,1296,1,17,0)
.
"KRN",8994,1296,1,18,0)
Array(x)=last item number^I^introductory text                    
"KRN",8994,1296,1,19,0)
Array(x)=last item number^T^text of question                     
"KRN",8994,1296,1,20,0)
Array(x)=last item number^A^allowed responses          
"KRN",8994,1296,1,21,0)
Array(x)=last item number^R^response cues
"KRN",8994,1297,-1)
0^8
"KRN",8994,1297,0)
YTAPI PRIVLEGE^PRIVL^YTAPI5^2^S^1
"KRN",8994,1297,1,0)
^8994.01^14^14^3020315^^
"KRN",8994,1297,1,1,0)
Returns user privlege to see psych test results.
"KRN",8994,1297,1,2,0)
 
"KRN",8994,1297,1,3,0)
Input: YSCODE ;code of test or interview to check privelges for
"KRN",8994,1297,1,4,0)
Output:
"KRN",8994,1297,1,5,0)
YSDATA(1)=[DATA]
"KRN",8994,1297,1,6,0)
YSDATA(2)=1^user privileged for all tests
"KRN",8994,1297,1,7,0)
        or
"KRN",8994,1297,1,8,0)
YSDATA(2)=1^exempt test"
"KRN",8994,1297,1,9,0)
        or
"KRN",8994,1297,1,10,0)
YSDATA(2)=1^interview
"KRN",8994,1297,1,11,0)
        or
"KRN",8994,1297,1,12,0)
YSDATA(2)=1^exempt test
"KRN",8994,1297,1,13,0)
        or
"KRN",8994,1297,1,14,0)
YSDATA(2)=0^no access
"KRN",8994,1298,-1)
0^10
"KRN",8994,1298,0)
YTAPI SAVE INCOMPLETES^SAVEINC^YTAPI7^2^S^1
"KRN",8994,1298,1,0)
^^14^14^3020315^
"KRN",8994,1298,1,1,0)
API to save responses of partially completed psychological tests.
"KRN",8994,1298,1,2,0)
 
"KRN",8994,1298,1,3,0)
Input:
"KRN",8994,1298,1,4,0)
        DFN ;ien of file 2 Patient
"KRN",8994,1298,1,5,0)
        YSCODE: code of test in file 604
"KRN",8994,1298,1,6,0)
        YSNEXT: next item number to be answered
"KRN",8994,1298,1,7,0)
        YSORDER: DUZ of staff ordering test
"KRN",8994,1298,1,8,0)
        R1: array of answers 1-200
"KRN",8994,1298,1,9,0)
        R2: array of answers 201-400
"KRN",8994,1298,1,10,0)
        R3: array of answers 401-600
"KRN",8994,1298,1,11,0)
 
"KRN",8994,1298,1,12,0)
Output:
"KRN",8994,1298,1,13,0)
        YSDATA(1)=[DATA]
"KRN",8994,1298,1,14,0)
        YSDATA(2)=saved ok
"KRN",8994,1299,-1)
0^2
"KRN",8994,1299,0)
YTAPI GET INCOMPLETE^GETINC^YTAPI7^2^S^1
"KRN",8994,1299,1,0)
^^12^12^3020315^
"KRN",8994,1299,1,1,0)
API to retrive partially completed psychological tests.
"KRN",8994,1299,1,2,0)
 
"KRN",8994,1299,1,3,0)
Input Required: DFN ;ien of file 2 Patient
"KRN",8994,1299,1,4,0)
                YSCODE ; code for entry in file 601 Psycholgical Testing
"KRN",8994,1299,1,5,0)
Output:
"KRN",8994,1299,1,6,0)
        YSDATA(1)=[DATA]
"KRN",8994,1299,1,7,0)
        YSDATA(2)=INSTRUMENT^DATE ENTERED^DATE ADMINISTERED 
"KRN",8994,1299,1,8,0)
CLERICALLY^NEXT ITEM^VALID RESPONSE STRING^CLERK TEST^ORDERED BY^DATE 
"KRN",8994,1299,1,9,0)
BEGUN
"KRN",8994,1299,1,10,0)
        YSDATA(3)=responses 1-200
"KRN",8994,1299,1,11,0)
        YSDATA(4)=responses 201-400
"KRN",8994,1299,1,12,0)
        YSDATA(5)=responses 401-600
"KRN",8994,1300,-1)
0^3
"KRN",8994,1300,0)
YTAPI LIST INCOMPLETES^LISTINC^YTAPI7^2^S^1
"KRN",8994,1300,1,0)
^^5^5^3020315^
"KRN",8994,1300,1,1,0)
API to returm a list of incomplete psychological tests.
"KRN",8994,1300,1,2,0)
 
"KRN",8994,1300,1,3,0)
Input Required: DFN ; ien of file 2 Patient
"KRN",8994,1300,1,4,0)
Output:        YSDATA(1)=[DATA]
"KRN",8994,1300,1,5,0)
               YSDATA(X)=CODE^DATE OF ADMIN^(not) restartable
"KRN",8994,1307,-1)
0^16
"KRN",8994,1307,0)
YTAPI TEST BULLETIN^SNDBUL^YTAPI9^2^S^1
"KRN",8994,1307,1,0)
^^10^10^3020315^
"KRN",8994,1307,1,1,0)
When a clerk gives a psychological test by order of a clinician, a VISTA 
"KRN",8994,1307,1,2,0)
email bulletin is sent to that clinician, informing him/her of the 
"KRN",8994,1307,1,3,0)
administration of the test, the date, the clerk and the patient.
"KRN",8994,1307,1,4,0)
 
"KRN",8994,1307,1,5,0)
Input: DFN ;ien of file 2 Patient
"KRN",8994,1307,1,6,0)
       YSORD ;DUZ of ordering clinician
"KRN",8994,1307,1,7,0)
 
"KRN",8994,1307,1,8,0)
Output:
"KRN",8994,1307,1,9,0)
only success vs. error is reported.
"KRN",8994,1307,1,10,0)
YSDATA(1)=[DATA]
"KRN",8994,1308,-1)
0^1
"KRN",8994,1308,0)
YTAPI CLERK RESPONSES^CLERK^YTAPI9^2^S^1
"KRN",8994,1308,1,0)
^8994.01^7^7^3020315^^
"KRN",8994,1308,1,1,0)
This API returns the possible answer alternatives for each question in a 
"KRN",8994,1308,1,2,0)
test or interview from file 601, Psychological Testing
"KRN",8994,1308,1,3,0)
 
"KRN",8994,1308,1,4,0)
Input Required: Code , the test/interview code ie MMPI2
"KRN",8994,1308,1,5,0)
Output: YSDATA(1)=[DATA]
"KRN",8994,1308,1,6,0)
        YSDATA(x)=Question number^A^string with approriate answers (ie 
"KRN",8994,1308,1,7,0)
TFX)
"KRN",8994,1311,-1)
0^15
"KRN",8994,1311,0)
YTAPI TEST BATTERY^BATT^YTAPI9^2^S^1
"KRN",8994,1311,1,0)
^^6^6^3020315^
"KRN",8994,1311,1,1,0)
Returns a list of all available test batteries and the tests within them.
"KRN",8994,1311,1,2,0)
 
"KRN",8994,1311,1,3,0)
Input: none
"KRN",8994,1311,1,4,0)
Output:
"KRN",8994,1311,1,5,0)
YSDATA(1)=[DATA]
"KRN",8994,1311,1,6,0)
YSADAT(x)=battery name^test1^test2^test3^test4
"KRN",8994,1312,-1)
0^11
"KRN",8994,1312,0)
YTAPI SAVE TEST COMMENT^ADDCOMM^YTRPEXT^2^^1
"KRN",8994,1312,1,0)
^8994.01^1^1^3020315^^^
"KRN",8994,1312,1,1,0)
This API is used to add comments to completed tests and interviews.
"KRN",8994,1312,2,0)
^8994.02A^2^2
"KRN",8994,1312,2,1,0)
YSDATA^1^200^1^1
"KRN",8994,1312,2,1,1,0)
^^9^9^3010831^
"KRN",8994,1312,2,1,1,1,0)
The YSDATA catains the following information:
"KRN",8994,1312,2,1,1,2,0)
  
"KRN",8994,1312,2,1,1,3,0)
YSDATA=DFN^DUZ^DATE/TIME TEST ENTERED^NAME OF TEST^AUTHOR^TOTAL LINES OF
"KRN",8994,1312,2,1,1,4,0)
COMMENT
"KRN",8994,1312,2,1,1,5,0)
 
"KRN",8994,1312,2,1,1,6,0)
DFN: Pointer to the Patient file
"KRN",8994,1312,2,1,1,7,0)
DATE/TIME TEST ENTERED: FileMan date/time format
"KRN",8994,1312,2,1,1,8,0)
NAME OF TEST : Test name in the MH Intrument file #601
"KRN",8994,1312,2,1,1,9,0)
DUZ and AUTHOR: Pointer to the New Person file #200
"KRN",8994,1312,2,2,0)
YSCOMMT^2^200^1^2
"KRN",8994,1312,2,2,1,0)
^8994.021^1^1^3010831^^^^
"KRN",8994,1312,2,2,1,1,0)
YSCOMMT array contains comment lines to be filed.
"KRN",8994,1312,2,"B","YSCOMMT",2)

"KRN",8994,1312,2,"B","YSDATA",1)

"KRN",8994,1312,2,"PARAMSEQ",1,1)

"KRN",8994,1312,2,"PARAMSEQ",2,2)

"KRN",8994,1312,3,0)
^8994.03^7^7^3010831^^
"KRN",8994,1312,3,1,0)
RESULT(1)="[ERROR]",RESULT(2)=" No test found"
"KRN",8994,1312,3,2,0)
 
"KRN",8994,1312,3,3,0)
RESULT(1)="[DATA]",RESULT(2)="Save ok"
"KRN",8994,1312,3,4,0)
 
"KRN",8994,1312,3,5,0)
RESULT(1)="[ERROR]",RESULT(2)="Comment line not created"
"KRN",8994,1312,3,6,0)
 
"KRN",8994,1312,3,7,0)
RESULT(1)="[ERROR]",RESULT(2)="No comment entered"
"MBREQ")
0
"ORD",0,9.8)
9.8;;1;RTNF^XPDTA;RTNE^XPDTA
"ORD",0,9.8,0)
ROUTINE
"ORD",1,9.2)
9.2;1;;;HELP^XPDTA1;HLPF1^XPDIA1;HLPE1^XPDIA1;HLPF2^XPDIA1;;HLPDEL^XPDIA1
"ORD",1,9.2,0)
HELP FRAME
"ORD",5,.4)
.4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%)
"ORD",5,.4,0)
PRINT TEMPLATE
"ORD",7,.402)
.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
"ORD",7,.402,0)
INPUT TEMPLATE
"ORD",15,101)
101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA
"ORD",15,101,0)
PROTOCOL
"ORD",16,8994)
8994;16;1;;;;;;;RPCDEL^XPDIA1
"ORD",16,8994,0)
REMOTE PROCEDURE
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"PKG",71,-1)
1^1
"PKG",71,0)
MENTAL HEALTH^YS^Version 5.01 of Mental Health
"PKG",71,20,0)
^9.402P^^
"PKG",71,22,0)
^9.49I^1^1
"PKG",71,22,1,0)
5.01^2941230^2950201
"PKG",71,22,1,"PAH",1,0)
60^3120815^4719
"PKG",71,22,1,"PAH",1,1,0)
^^8^8^3120815
"PKG",71,22,1,"PAH",1,1,1,0)
Patch YS*5.01*60 addresses the retirement of Mental Health Options, Files,
"PKG",71,22,1,"PAH",1,1,2,0)
Data Dictionaries, patient data associated with these files, and
"PKG",71,22,1,"PAH",1,1,3,0)
associated templates determined by the Mental Health Strategic Healthcare
"PKG",71,22,1,"PAH",1,1,4,0)
Group to be obsolete and are no longer supported by Health Systems Design
"PKG",71,22,1,"PAH",1,1,5,0)
and Development.  All the software, files, options, and templates were
"PKG",71,22,1,"PAH",1,1,6,0)
designated as obsolete in 2004 or earlier.
"PKG",71,22,1,"PAH",1,1,7,0)
 
"PKG",71,22,1,"PAH",1,1,8,0)
A complete description of this patch can be found on Forum.
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
YES
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
231
"RTN","YS03ENV")
1^264
"RTN","YS04ENV")
1^265
"RTN","YS04POST")
1^266
"RTN","YS05ENV")
1^267
"RTN","YS05POST")
1^224
"RTN","YS06ENV")
1^36
"RTN","YS23ENV")
1^268
"RTN","YS23POST")
1^269
"RTN","YS24ENV")
1^270
"RTN","YS24POST")
1^271
"RTN","YS26ENV")
1^272
"RTN","YS29ENV")
1^273
"RTN","YS30ENV")
1^274
"RTN","YS30PRE")
1^275
"RTN","YS32ENV")
1^276
"RTN","YS33ENV")
1^277
"RTN","YS37ENV")
1^278
"RTN","YS38ENV")
1^279
"RTN","YS38POST")
1^280
"RTN","YS39POST")
1^281
"RTN","YS42ENV")
1^282
"RTN","YS43POST")
1^283
"RTN","YS501100")
1^288
"RTN","YS501P82")
1^289
"RTN","YS501P83")
1^290
"RTN","YS60POST")
0^^B7070768
"RTN","YS60POST",1,0)
YS60POST ; HIOFO/hrubovcak,FT - PATCH YS*5.01*60 post-init. ;8/8/12 4:07pm
"RTN","YS60POST",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YS60POST",3,0)
 ; post-init  to delete FileMan files
"RTN","YS60POST",4,0)
 ;Reference to EN^DIU2 supported by DBIA #10014
"RTN","YS60POST",5,0)
 ;Reference to XPDUTL APIs supported by DBIA #10141
"RTN","YS60POST",6,0)
 ;Reference to XLFDT APIs supported by DBIA #10103
"RTN","YS60POST",7,0)
 ;
"RTN","YS60POST",8,0)
EN ;
"RTN","YS60POST",9,0)
 D DELFLS,DDMOD,FX60193
"RTN","YS60POST",10,0)
 Q
"RTN","YS60POST",11,0)
 ;
"RTN","YS60POST",12,0)
DELFLS ; files to be deleted
"RTN","YS60POST",13,0)
 ; # ; name  ; storage global
"RTN","YS60POST",14,0)
 ;602;MENTAL HEALTH SITE PARAMETERS;^YSA(602,
"RTN","YS60POST",15,0)
 ;605;MH TEXT;^YTX(
"RTN","YS60POST",16,0)
 ;624;JOB BANK;^YSG("JOB",
"RTN","YS60POST",17,0)
 ;627.99;DSM CONVERSION;^YSD(627.99,
"RTN","YS60POST",18,0)
 ;628;YSEXPERT;^YS(628,
"RTN","YS60POST",19,0)
 ;
"RTN","YS60POST",20,0)
 D MES^XPDUTL("File deletion started "_$$NOW)
"RTN","YS60POST",21,0)
 ; delete DD's, sub-files first
"RTN","YS60POST",22,0)
 K DIU
"RTN","YS60POST",23,0)
 ; MENTAL HEALTH SITE PARAMETERS (#602)
"RTN","YS60POST",24,0)
 F DIU=602.01,602.015 S DIU(0)="DET" D EN^DIU2
"RTN","YS60POST",25,0)
 S DIU=602,DIU(0)="DET" D EN^DIU2
"RTN","YS60POST",26,0)
 ; MH TEXT (#605)
"RTN","YS60POST",27,0)
 S DIU=605.01,DIU(0)="DET" D EN^DIU2
"RTN","YS60POST",28,0)
 S DIU=605,DIU(0)="ET" D EN^DIU2  ; leave data to prevent <PROTECT> error
"RTN","YS60POST",29,0)
 ; JOB BANK (#624)
"RTN","YS60POST",30,0)
 S DIU=624,DIU(0)="DET" D EN^DIU2
"RTN","YS60POST",31,0)
 ; DSM CONVERSION (#627.99)
"RTN","YS60POST",32,0)
 F DIU=627.99103,627.9901,627.99111,627.99 S DIU(0)="DET" D EN^DIU2
"RTN","YS60POST",33,0)
 ; YSEXPERT (#628)
"RTN","YS60POST",34,0)
 F DIU=628.232,628.23,628.02,628 S DIU(0)="DET" D EN^DIU2
"RTN","YS60POST",35,0)
 ;
"RTN","YS60POST",36,0)
 ; delete any ^YSG("ERR") data
"RTN","YS60POST",37,0)
 N J,C S J="",C=0
"RTN","YS60POST",38,0)
 F  S J=$O(^YSG("ERR",J)) Q:J=""  S C=C+1  ; count entries
"RTN","YS60POST",39,0)
 K ^YSG("ERR") D MES^XPDUTL("Deleted "_$FN(C,",")_" entr"_$S(C'=1:"ies",1:"y")_" from ^YSG(""ERR"")")
"RTN","YS60POST",40,0)
 ;
"RTN","YS60POST",41,0)
 ; 605;MH TEXT;^YTX(
"RTN","YS60POST",42,0)
 ; delete ^YTX data, prevent <PROTECT> error
"RTN","YS60POST",43,0)
 ; don't touch ^YTX(614.501,0)="MH INSTRUMENT EXCHANGE LOG^614.501"
"RTN","YS60POST",44,0)
 S J="" F  S J=$O(^YTX(J)) Q:(J="")!(J>600)  K ^YTX(J)
"RTN","YS60POST",45,0)
 ;
"RTN","YS60POST",46,0)
 D MES^XPDUTL("File deletion finished "_$$NOW)
"RTN","YS60POST",47,0)
 ;
"RTN","YS60POST",48,0)
 K DIU
"RTN","YS60POST",49,0)
 Q
"RTN","YS60POST",50,0)
 ;
"RTN","YS60POST",51,0)
DDMOD ; modify DD access
"RTN","YS60POST",52,0)
 ;
"RTN","YS60POST",53,0)
 D MES^XPDUTL("Updating DD access "_$$NOW)
"RTN","YS60POST",54,0)
 N J,YSF,YSLN,X
"RTN","YS60POST",55,0)
 F YSLN=1:1 S X=$P($T(DDLST+YSLN),";;",2),YSF=$P(X,U) Q:'YSF  D
"RTN","YS60POST",56,0)
 .Q:'$$VFILE^DILFD(YSF)  ; does the file exist?
"RTN","YS60POST",57,0)
 .N YSECURTY,YSDDERR
"RTN","YS60POST",58,0)
 .F J="DD","RD","WR","DEL","LAYGO","AUDIT" S YSECURTY(J)="@"
"RTN","YS60POST",59,0)
 .D FILESEC^DDMOD(YSF,.YSECURTY,"YSDDERR")
"RTN","YS60POST",60,0)
 .D MES^XPDUTL("Updated the DD for file #"_YSF)
"RTN","YS60POST",61,0)
 ;
"RTN","YS60POST",62,0)
 Q
"RTN","YS60POST",63,0)
 ;
"RTN","YS60POST",64,0)
FX60193 ; strip control chars. in W-P field in file #601.93
"RTN","YS60POST",65,0)
 D MES^XPDUTL("Checking entries in file 601.93 "_$$NOW)
"RTN","YS60POST",66,0)
 D AL60193^YTRPWRP
"RTN","YS60POST",67,0)
 D MES^XPDUTL("Done checking file 601.93 "_$$NOW)
"RTN","YS60POST",68,0)
 Q
"RTN","YS60POST",69,0)
 ;
"RTN","YS60POST",70,0)
 ; now, external format
"RTN","YS60POST",71,0)
NOW() Q $$FMTE^XLFDT($$NOW^XLFDT)
"RTN","YS60POST",72,0)
 ;
"RTN","YS60POST",73,0)
DDLST ; list of data dictionaries to have security updated
"RTN","YS60POST",74,0)
 ;;90^MEDICAL RECORD
"RTN","YS60POST",75,0)
 ;;99^PT. TEXT
"RTN","YS60POST",76,0)
 ;;615^MH CLINICAL FILE
"RTN","YS60POST",77,0)
 ;;600.7^CRISIS NOTE DISPLAY
"RTN","YS60POST",78,0)
 ;;617^MH WAIT LIST
"RTN","YS60POST",79,0)
 ;;618^MENTAL HEALTH CENSUS
"RTN","YS60POST",80,0)
 ;;618.2^MENTAL HEALTH TEAM
"RTN","YS60POST",81,0)
 ;;618.4^MENTAL HEALTH INPT
"RTN","YS60POST",82,0)
 ;;620^PROBLEM
"RTN","YS60POST",83,0)
 ;;625^INDICATOR
"RTN","YS60POST",84,0)
 ;
"RTN","YS60PRE")
0^^B9642192
"RTN","YS60PRE",1,0)
YS60PRE ; HIOFO/hrubovcak,FT - PATCH YS*5.01*60 pre-init. ;8/8/12 3:59pm
"RTN","YS60PRE",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YS60PRE",3,0)
 ; pre-init  to delete Mental Health files
"RTN","YS60PRE",4,0)
 ;Reference to XLFDT APIs supported by DBIA #10103
"RTN","YS60PRE",5,0)
 ;Reference to XPDUTL APIs supported by DBIA #10141
"RTN","YS60PRE",6,0)
 ;Reference to LIST^DIC(19, supported by DBIA #10075
"RTN","YS60PRE",7,0)
 ;Reference to ^%ZOSF supported by IA #10096
"RTN","YS60PRE",8,0)
 ;
"RTN","YS60PRE",9,0)
EN ;
"RTN","YS60PRE",10,0)
 D ENTDEL,D60186,D60187
"RTN","YS60PRE",11,0)
 Q
"RTN","YS60PRE",12,0)
 ;
"RTN","YS60PRE",13,0)
ENTDEL ;file entry deletion
"RTN","YS60PRE",14,0)
 ;;605;MH TEXT;^YTX(
"RTN","YS60PRE",15,0)
 ;;627.99;DSM CONVERSION;^YSD(627.99,
"RTN","YS60PRE",16,0)
 ;;628;YSEXPERT;^YS(628,
"RTN","YS60PRE",17,0)
 ;* end of file list *
"RTN","YS60PRE",18,0)
 ;
"RTN","YS60PRE",19,0)
 D MES^XPDUTL("File entry deletion started "_$$NOW)
"RTN","YS60PRE",20,0)
 ; delete file entries first
"RTN","YS60PRE",21,0)
 K DA,DIK,DIU,X,Y,YSCNT,YSDA,YSDELDT,YSDTAFND,YSL,YSND,YSNOW,YSUB
"RTN","YS60PRE",22,0)
 F YSL=1:1 S X=$P($T(ENTDEL+YSL),";;",2) Q:X=""  D
"RTN","YS60PRE",23,0)
 .S DIK=$P(X,";",3),YSDA=0,YSCNT=0 D MES^XPDUTL("  Deleting entries for "_DIK)
"RTN","YS60PRE",24,0)
 .F  S YSDA=$O(@(DIK_YSDA_")")) Q:'YSDA  S DA=YSDA,YSCNT=YSCNT+1 D ^DIK
"RTN","YS60PRE",25,0)
 .S Y=" Deleted "_$S(YSCNT=0:"Zero",1:$FN(YSCNT,","))_" entr"_$S(YSCNT=1:"y",1:"ies")  D MES^XPDUTL(Y)
"RTN","YS60PRE",26,0)
 ;
"RTN","YS60PRE",27,0)
 ;backup and delete 1 file
"RTN","YS60PRE",28,0)
 ;624;JOB BANK;^YSG("JOB",
"RTN","YS60PRE",29,0)
 ;
"RTN","YS60PRE",30,0)
 ;YSDTAFND - flag, indicates data found
"RTN","YS60PRE",31,0)
 S YSND="YS*5.01*60",YSDTAFND=0
"RTN","YS60PRE",32,0)
 S YSNOW=$$NOW,YSDELDT=$$H2F^XLFDT($H+93) ; 3 months (93 days)
"RTN","YS60PRE",33,0)
 F YSUB="JOB" D
"RTN","YS60PRE",34,0)
 .Q:$O(^YSG(YSUB,0))=""  S X=$G(^(0))  ; quit if no data
"RTN","YS60PRE",35,0)
 .S Y=$P(X,U) D MES^XPDUTL("Saving "_Y_" data to ^XTMP("_YSND_")")
"RTN","YS60PRE",36,0)
 .M ^XTMP(YSND,YSNOW,YSUB)=^YSG(YSUB)  ; YSNOW allows multiple runs of pre-init
"RTN","YS60PRE",37,0)
 .; cleanup data, leave file's zero node
"RTN","YS60PRE",38,0)
 .S YSDTAFND=YSDTAFND+1,X=0 F  S X=$O(^YSG(YSUB,X)) Q:X=""  K ^YSG(YSUB,X)
"RTN","YS60PRE",39,0)
 .D MES^XPDUTL("Entries in "_Y_" deleted.")
"RTN","YS60PRE",40,0)
 ;
"RTN","YS60PRE",41,0)
 ; if data found set zero node
"RTN","YS60PRE",42,0)
 S:YSDTAFND ^XTMP(YSND,0)=YSDELDT_U_YSNOW_U_"Backup for "_YSND_" installation"
"RTN","YS60PRE",43,0)
 ;
"RTN","YS60PRE",44,0)
 D MES^XPDUTL("File entry deletion finished "_$$NOW)
"RTN","YS60PRE",45,0)
 ;
"RTN","YS60PRE",46,0)
 K DA,DIK,DIU,X,Y,YSCNT,YSDA,YSDELDT,YSDTAFND,YSL,YSND,YSNOW,YSUB
"RTN","YS60PRE",47,0)
 Q
"RTN","YS60PRE",48,0)
 ;
"RTN","YS60PRE",49,0)
 ; now, external format
"RTN","YS60PRE",50,0)
NOW() Q $$FMTE^XLFDT($$NOW^XLFDT)
"RTN","YS60PRE",51,0)
 ;
"RTN","YS60PRE",52,0)
CHKSUM(RTN) ; function, return routine Checksum
"RTN","YS60PRE",53,0)
 N %,%1,%2,%3,X,Y S X=$G(RTN) Q:X="" "*"
"RTN","YS60PRE",54,0)
 X ^%ZOSF("RSUM1") Q Y
"RTN","YS60PRE",55,0)
 ;
"RTN","YS60PRE",56,0)
D60186 ;Delete entries where SCALEGROUPNAME="RPCBroker1" in MH SCALEGROUPS file (601.86)
"RTN","YS60PRE",57,0)
 N DA,DIK,X,YSC,YSIEN
"RTN","YS60PRE",58,0)
 S YSC=0  ; counter
"RTN","YS60PRE",59,0)
 F YSIEN=127:1:131 D
"RTN","YS60PRE",60,0)
 .Q:$P($G(^YTT(601.86,YSIEN,0)),U,3)'="RPCBroker1"  ;wrong entry
"RTN","YS60PRE",61,0)
 .S DA=YSIEN,DIK="^YTT(601.86,"
"RTN","YS60PRE",62,0)
 .D ^DIK S YSC=YSC+1
"RTN","YS60PRE",63,0)
 ;
"RTN","YS60PRE",64,0)
 S X="Deleted "_$S(YSC:YSC,1:"zero")_" entr"_$S('(YSC=1):"ies",1:"y")_" in MH SCALEGROUPS File (#601.86)"
"RTN","YS60PRE",65,0)
 D MES^XPDUTL(X)
"RTN","YS60PRE",66,0)
 Q
"RTN","YS60PRE",67,0)
D60187 ;Delete entries where SCALE NAME="R1 Scale" in MH SCALES file (601.87)
"RTN","YS60PRE",68,0)
 N DA,DIK,X,YSC,YSIEN
"RTN","YS60PRE",69,0)
 S YSC=0  ; counter
"RTN","YS60PRE",70,0)
 F YSIEN=497,498 D
"RTN","YS60PRE",71,0)
 .Q:$P($G(^YTT(601.87,YSIEN,0)),U,4)'="R1 Scale"  ;wrong entry
"RTN","YS60PRE",72,0)
 .S DA=YSIEN,DIK="^YTT(601.87,"
"RTN","YS60PRE",73,0)
 .D ^DIK S YSC=YSC+1
"RTN","YS60PRE",74,0)
 ;
"RTN","YS60PRE",75,0)
 S X="Deleted "_$S(YSC:YSC,1:"zero")_" entr"_$S('(YSC=1):"ies",1:"y")_" in MH SCALES File (#601.87)"
"RTN","YS60PRE",76,0)
 D MES^XPDUTL(X)
"RTN","YS60PRE",77,0)
 Q
"RTN","YS60PRE",78,0)
 ;
"RTN","YS85POST")
1^157
"RTN","YS85PRE")
1^158
"RTN","YS96POST")
1^284
"RTN","YS97POST")
1^285
"RTN","YSANTEG")
1^286
"RTN","YSAPOST")
1^287
"RTN","YSASCF")
1^1
"RTN","YSASNAR")
0^252^B38698089
"RTN","YSASNAR",1,0)
YSASNAR ;ALB/ASF,SLC/DKG,HIOFO/FT - ASI INTERVIEW REPORTER ;3/13/12  3:25 pm
"RTN","YSASNAR",2,0)
 ;;5.01;MENTAL HEALTH;**24,30,37,38,44,55,67,76,103,60**;Dec 30, 1994;Build 47
"RTN","YSASNAR",3,0)
 ;
"RTN","YSASNAR",4,0)
 ;Reference to ^%ZISC supported by IA #10089
"RTN","YSASNAR",5,0)
 ;Reference to ^%ZTLOAD supported by IA #10063
"RTN","YSASNAR",6,0)
 ;Reference to HOME^%ZIS supported by IA #1008
"RTN","YSASNAR",7,0)
 ;Reference to ^%ZIS supported by IA #10086
"RTN","YSASNAR",8,0)
 ;Reference to $$GET1^DIQ() supported by IA #2056
"RTN","YSASNAR",9,0)
 ;Reference to $$FMTE^XLFDT supported by IA #10103
"RTN","YSASNAR",10,0)
 ;Reference to DEM^VADPT supported by IA #10061
"RTN","YSASNAR",11,0)
 ;Reference to ^DIWP supported by IA #10011
"RTN","YSASNAR",12,0)
 ;Reference to ^DIR supported by IA #10026
"RTN","YSASNAR",13,0)
 ;Reference to ^DD("DD" supported by IA #10017
"RTN","YSASNAR",14,0)
 ;Reference to ^VA(200 supported by IA #10060
"RTN","YSASNAR",15,0)
 ;Reference to ^DPT( supported by IA #10035
"RTN","YSASNAR",16,0)
 ;
"RTN","YSASNAR",17,0)
EN1(YSASDA) ;Entry point to display ASI
"RTN","YSASNAR",18,0)
 Q:$G(YSASDA)'>0
"RTN","YSASNAR",19,0)
 N YSASN,YSASNA,YSZZ,YSHDR,YSASD,YSAST,YSAS0,DIERR,YSI,YSASC,YSASN2
"RTN","YSASNAR",20,0)
 ;ASK DEVICE 
"RTN","YSASNAR",21,0)
 N YSASQUIT,%ZIS,POP
"RTN","YSASNAR",22,0)
 S %ZIS="QM"
"RTN","YSASNAR",23,0)
 D ^%ZIS
"RTN","YSASNAR",24,0)
 Q:$G(POP)
"RTN","YSASNAR",25,0)
 I $D(IO("Q")) D  Q
"RTN","YSASNAR",26,0)
 .N ZTRTN,ZTDESC,ZTSAVE
"RTN","YSASNAR",27,0)
 .S ZTRTN="QTEP^YSASNAR"
"RTN","YSASNAR",28,0)
 .S ZTDESC="YSASPRT ASI NARRATIVE PRINT"
"RTN","YSASNAR",29,0)
 .S ZTSAVE("YSASDA")=""
"RTN","YSASNAR",30,0)
 .D ^%ZTLOAD W:$D(ZTSK) !!,"Your Task Number is "_ZTSK
"RTN","YSASNAR",31,0)
 .D HOME^%ZIS
"RTN","YSASNAR",32,0)
 .Q
"RTN","YSASNAR",33,0)
 U IO
"RTN","YSASNAR",34,0)
QTEP ;Queued Task Entry Point
"RTN","YSASNAR",35,0)
 S:$D(ZTQUEUED) ZTREQ="@"
"RTN","YSASNAR",36,0)
 N G,G2,N,P1,P2,R,V,V1,Y1,YSA,YSAGE,YSAS0,YSASC,YSASD,YSASIG,YSASN,YSASNA,YSASQUIT,YSAST,YSASWP
"RTN","YSASNAR",37,0)
 N YSASWP,YSBID,YSDOB,YSHDR,YSHIML,YSHIMU,YSI,YSJ,YSLAST,YSLCK,YSLFN,YSNM,YSPART,YSPOSL,YSPOSU
"RTN","YSASNAR",38,0)
 N YSPROL,YSPROU,YSSC,YSSCK,YSSEX,YSSSN,YSSTEM,YSTITLE,YSX,YSYCK,YSYX,YSZ,YSZZ
"RTN","YSASNAR",39,0)
 S YSZZ=0
"RTN","YSASNAR",40,0)
 S YSAS0=^YSTX(604,YSASDA,0),DFN=$P(YSAS0,"^",2)
"RTN","YSASNAR",41,0)
 D DEM^VADPT
"RTN","YSASNAR",42,0)
 S YSASD=$$FMTE^XLFDT($P(YSAS0,U,5),"5ZD")
"RTN","YSASNAR",43,0)
 S YSAST=$$GET1^DIQ(604,YSASDA_",",.04)
"RTN","YSASNAR",44,0)
 S YSASC=$$GET1^DIQ(604,YSASDA_",",.09)
"RTN","YSASNAR",45,0)
 S YSASIG=$$GET1^DIQ(604,YSASDA_",",.51,"I")
"RTN","YSASNAR",46,0)
 S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID"),YSBID=VA("BID")
"RTN","YSASNAR",47,0)
 S YSHDR=VADM(1)_"  "_"xxx-xx-"_YSBID_$J("",(20-$L(VADM(1))))_" ASI "_YSAST_"  on "_YSASD_" by: "_YSASC
"RTN","YSASNAR",48,0)
 ;
"RTN","YSASNAR",49,0)
MAIN ;
"RTN","YSASNAR",50,0)
 K ^TMP($J,"YSTMP"),^TMP($J,"W")
"RTN","YSASNAR",51,0)
 S YSLFN=1,^TMP($J,"YSTMP",0,1,0)=""
"RTN","YSASNAR",52,0)
 D VARPRO
"RTN","YSASNAR",53,0)
 D R1
"RTN","YSASNAR",54,0)
 D SIG
"RTN","YSASNAR",55,0)
 D PRT
"RTN","YSASNAR",56,0)
 D ^%ZISC
"RTN","YSASNAR",57,0)
 Q
"RTN","YSASNAR",58,0)
R1 ;
"RTN","YSASNAR",59,0)
 S X=$S(YSAST?1"ASI-MV".E:"ASI-MV NARRATIVE",YSAST?1"FO".E:"FOLLOWUP NARRATIVE",1:"GENERAL"),YSPART=$O(^YSTX(604.68,"B",X,0))
"RTN","YSASNAR",60,0)
 F YSJ=1:1 Q:'$D(^YSTX(604.68,YSPART,1,YSJ,0))  S YSA=^(0) D R2
"RTN","YSASNAR",61,0)
 Q
"RTN","YSASNAR",62,0)
R2 ;
"RTN","YSASNAR",63,0)
 I YSA?1"~".E Q
"RTN","YSASNAR",64,0)
 I YSA?1"W{".E1"}" K YSWP S YSWP=$$GET1^DIQ(604,YSASDA_",",$E(YSA,3,$L(YSA)-1),"Z","YSWP") D:YSWP'=""  K YSWP Q
"RTN","YSASNAR",65,0)
 . S YSN2="" F  S YSN2=$O(YSWP(YSN2)) Q:YSN2'>0  S YSLFN=YSLFN+1,^TMP($J,"YSTMP",0,YSLFN,0)=YSWP(YSN2,0)
"RTN","YSASNAR",66,0)
 ;
"RTN","YSASNAR",67,0)
 I YSA'["{" S X=YSA D:$L(X) L Q  ;DIWL=0,DIWR=IOM,X=YSA D ^DIWP Q
"RTN","YSASNAR",68,0)
PRO ;evaluate pronoun, possessive etc
"RTN","YSASNAR",69,0)
 F YSZ=1:1:999 Q:YSA'["{"  D
"RTN","YSASNAR",70,0)
 . S P1=$F(YSA,"{")-1,P2=$F(YSA,"}")
"RTN","YSASNAR",71,0)
 . Q:'P1!'P2
"RTN","YSASNAR",72,0)
 . S G=$E(YSA,P1+1,P2-2),V=0
"RTN","YSASNAR",73,0)
 . I $P(G,";")?."."1N.NP D  D CONDIT,ULP
"RTN","YSASNAR",74,0)
 .. S G2=$$GET1^DIQ(604,YSASDA_",",$P(G,";"),"","YSASWP")
"RTN","YSASNAR",75,0)
 .. S V=$S(G2?1N.N:+G2,1:G2) ;5/30 ASF
"RTN","YSASNAR",76,0)
 . S:G="Pro" V=$S(YSSEX="F":"She",1:"He")
"RTN","YSASNAR",77,0)
 . S:G="pro" V=$S(YSSEX="F":"she",1:"he")
"RTN","YSASNAR",78,0)
 . S:G="Pos" V=$S(YSSEX="F":"Her",1:"His")
"RTN","YSASNAR",79,0)
 . S:G="pos" V=$S(YSSEX="F":"her",1:"his")
"RTN","YSASNAR",80,0)
 . S:G="him" V=$S(YSSEX="F":"her",1:"him")
"RTN","YSASNAR",81,0)
 . S:G="himself" V=$S(YSSEX="F":"herself",1:"himself")
"RTN","YSASNAR",82,0)
 . S:G="Title" V=$S(YSSEX="F":"Ms.",1:"Mr.")
"RTN","YSASNAR",83,0)
 . I G="Blank" S:$L($G(^TMP($J,"YSTMP",0,YSLFN,0))) YSLFN=YSLFN+1 S ^TMP($J,"YSTMP",0,YSLFN,0)=$G(^TMP($J,"YSTMP",0,YSLFN,0))_"|BLANK(1)||NOBLANKLINE|",YSLFN=YSLFN+1,V=""
"RTN","YSASNAR",84,0)
 . S:G="Line" YSLFN=YSLFN+1,^TMP($J,"YSTMP",0,YSLFN,0)="",V=""
"RTN","YSASNAR",85,0)
 . I G="Last" S X=$P($P(^DPT(DFN,0),U),",") D
"RTN","YSASNAR",86,0)
 .. F %=2:1:$L(X) I $E(X,%)?1U,$E(X,%-1)?1A S X=$E(X,0,%-1)_$C($A(X,%)+32)_$E(X,%+1,999)
"RTN","YSASNAR",87,0)
 .. S V=X
"RTN","YSASNAR",88,0)
 . I $P(G,";")="Field" S @($P(G,";",2))=$$GET1^DIQ(604,YSASDA_",",$P(G,";",3)),V="" I $P(G,";",4)'="" S YSSC=";",YSX="S @($P(G,YSSC,2))=$S("_$P(G,";",4)_")" X YSX
"RTN","YSASNAR",89,0)
 . I $P(G,";")="List" K V D  K V S V=""
"RTN","YSASNAR",90,0)
 .. S V1=$P(G,";",2),I1=0 F I=1:1 Q:$P(V1,",",I)=""  S:@($P(V1,",",I))'="" I1=I1+1,V(I1)=@($P(V1,",",I))
"RTN","YSASNAR",91,0)
 .. I '$D(V(1)) S X=$P(G,";",3) D L Q
"RTN","YSASNAR",92,0)
 .. F I1=1:1 Q:'$D(V(I1))  S X=$S(I1=1:" ",'$D(V(I1+1)):" and ",1:", ")_V(I1) D L
"RTN","YSASNAR",93,0)
R . ;called from YSASPNT 
"RTN","YSASNAR",94,0)
 . S X=$E(YSA,1,P1-1) D:$L(X) L
"RTN","YSASNAR",95,0)
 . I $D(YSASWP) S V="" D  K YSASWP
"RTN","YSASNAR",96,0)
 .. F I3=1:1 Q:'$D(YSASWP(I3))  S X=YSASWP(I3)_" " D:$L(X) L
"RTN","YSASNAR",97,0)
 . S X=V D:$L(X) L
"RTN","YSASNAR",98,0)
 . S YSA=$E(YSA,P2,999)
"RTN","YSASNAR",99,0)
 . I YSA'["{" S X=YSA D:$L(X) L
"RTN","YSASNAR",100,0)
 ;
"RTN","YSASNAR",101,0)
 Q
"RTN","YSASNAR",102,0)
SIG ; signature
"RTN","YSASNAR",103,0)
 S YSLFN=YSLFN+1,^TMP($J,"YSTMP",0,YSLFN,0)=""
"RTN","YSASNAR",104,0)
 S YSLFN=YSLFN+1,^TMP($J,"YSTMP",0,YSLFN,0)="esig: "
"RTN","YSASNAR",105,0)
 S Y=$P($G(^YSTX(604,YSASDA,.5)),U,2) S:Y?1N.N Y=$G(^VA(200,Y,20)),Y=$P(Y,U,2)_" "_$P(Y,U,3)
"RTN","YSASNAR",106,0)
 S ^TMP($J,"YSTMP",0,YSLFN,0)=^TMP($J,"YSTMP",0,YSLFN,0)_Y
"RTN","YSASNAR",107,0)
 S Y=$G(^YSTX(604,YSASDA,12)) I Y'="" X ^DD("DD") S YSLFN=YSLFN+1,^TMP($J,"YSTMP",0,YSLFN,0)="signed: "_Y
"RTN","YSASNAR",108,0)
 Q
"RTN","YSASNAR",109,0)
END ;
"RTN","YSASNAR",110,0)
 K I,YSLCK,R,YSSTEM,YSYX,YSYCK,YSSCK Q
"RTN","YSASNAR",111,0)
L ;
"RTN","YSASNAR",112,0)
 S ^TMP($J,"YSTMP",0,YSLFN,0)=$G(^TMP($J,"YSTMP",0,YSLFN,0))_X
"RTN","YSASNAR",113,0)
 I $L(^TMP($J,"YSTMP",0,YSLFN,0))>80 D
"RTN","YSASNAR",114,0)
 . S Y=^TMP($J,"YSTMP",0,YSLFN,0)
"RTN","YSASNAR",115,0)
 . F I=$L(Y):-1:1 S Y1=$E(Y,I) I Y1=" "&(I<81) S ^TMP($J,"YSTMP",0,YSLFN,0)=$E(Y,1,I-1),YSLFN=YSLFN+1,^TMP($J,"YSTMP",0,YSLFN,0)=$E(Y,I+1,999) Q 
"RTN","YSASNAR",116,0)
 Q
"RTN","YSASNAR",117,0)
PRT ; Print output
"RTN","YSASNAR",118,0)
 W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
"RTN","YSASNAR",119,0)
 S N=0 F  S N=$O(^TMP($J,"YSTMP",0,N)) Q:N'>0!YSZZ  D
"RTN","YSASNAR",120,0)
 . S X=^TMP($J,"YSTMP",0,N,0),DIWL=1,DIWF="WN" D ^DIWP
"RTN","YSASNAR",121,0)
 . I IOT'="HFS" D:$Y+4>IOSL WAIT ;ASF 3/7/03
"RTN","YSASNAR",122,0)
 ;
"RTN","YSASNAR",123,0)
 Q
"RTN","YSASNAR",124,0)
WAIT ;
"RTN","YSASNAR",125,0)
 F I0=1:1:IOSL-$Y-2 W !
"RTN","YSASNAR",126,0)
 N DTOUT,DUOUT,DIRUT
"RTN","YSASNAR",127,0)
 I IOST?1"C".E W $C(7) K DIR S DIR(0)="E" D ^DIR K DIR S YSZZ=$D(DIRUT)
"RTN","YSASNAR",128,0)
 Q:YSZZ
"RTN","YSASNAR",129,0)
 W @IOF,YSHDR,! W:'YSASIG ?25,"##### Unsigned Draft #####",!
"RTN","YSASNAR",130,0)
 Q
"RTN","YSASNAR",131,0)
TEST S G="X;;L",V="TEST"
"RTN","YSASNAR",132,0)
ULP ;
"RTN","YSASNAR",133,0)
 Q:$P(G,";",3)=""
"RTN","YSASNAR",134,0)
 Q:$P(G,";",3)="P"&($P(G,";")=".09:20.3")  ;MJD 01/06/2000
"RTN","YSASNAR",135,0)
 I $P(G,";",3)="P" F %=2:1:$L(V) I $E(V,%)?1U,$E(V,%-1)?1A S V=$E(V,0,%-1)_$C($A(V,%)+32)_$E(V,%+1,999)
"RTN","YSASNAR",136,0)
 I $P(G,";",3)="L" F %=1:1:$L(V) I $E(V,%)?1U S V=$E(V,0,%-1)_$C($A(V,%)+32)_$E(V,%+1,999)
"RTN","YSASNAR",137,0)
 I $P(G,";",3)="U" F %=1:1:$L(V) S:$E(V,%)?1L V=$E(V,0,%-1)_$C($A(V,%)-32)_$E(V,%+1,999)
"RTN","YSASNAR",138,0)
 Q
"RTN","YSASNAR",139,0)
CONDIT ;conditional
"RTN","YSASNAR",140,0)
 Q:$P(G,";",2)=""
"RTN","YSASNAR",141,0)
 S YSX="S V=$S("_$P(G,";",2)_")"
"RTN","YSASNAR",142,0)
 ;S X=YSX D ^DIM
"RTN","YSASNAR",143,0)
 ;I '$D(X) S V="###ERROR Line "_YSJ_" ###" Q
"RTN","YSASNAR",144,0)
 X YSX
"RTN","YSASNAR",145,0)
 Q
"RTN","YSASNAR",146,0)
VARPRO ; PATIENT VARIABLES
"RTN","YSASNAR",147,0)
 S YSPROU=$S(YSSEX="F":"She",1:"He")
"RTN","YSASNAR",148,0)
 S YSPROL=$S(YSSEX="F":"she",1:"he")
"RTN","YSASNAR",149,0)
 S YSPOSU=$S(YSSEX="F":"Her",1:"His")
"RTN","YSASNAR",150,0)
 S YSPOSL=$S(YSSEX="F":"her",1:"his")
"RTN","YSASNAR",151,0)
 S YSHIML=$S(YSSEX="F":"her",1:"him")
"RTN","YSASNAR",152,0)
 S YSHIMU=$S(YSSEX="F":"Her",1:"Him")
"RTN","YSASNAR",153,0)
 S YSTITLE=$S(YSSEX="F":"Ms.",1:"Mr.")
"RTN","YSASNAR",154,0)
 S X=$P($P(^DPT(DFN,0),U),",") D  S YSLAST=X
"RTN","YSASNAR",155,0)
 . F %=2:1:$L(X) I $E(X,%)?1U,$E(X,%-1)?1A S X=$E(X,0,%-1)_$C($A(X,%)+32)_$E(X,%+1,999)
"RTN","YSASNAR",156,0)
 Q
"RTN","YSASPNT")
0^236^B10291993
"RTN","YSASPNT",1,0)
YSASPNT ;ALB/ASF-TIU PROGRESS NOTE ;10/16/01  10:23
"RTN","YSASPNT",2,0)
 ;;5.01;MENTAL HEALTH;**39,73,88,60**;Dec 30, 1994;Build 47
"RTN","YSASPNT",3,0)
 ;
"RTN","YSASPNT",4,0)
 ; reference to ^TMP("TIUP",$J) supported by DBIA 1911
"RTN","YSASPNT",5,0)
 ;
"RTN","YSASPNT",6,0)
MAIN(YSASDA) ;
"RTN","YSASPNT",7,0)
 N VA,VADM,YSASAUTH,YSASC,YSAUTOSG,YSNOW,YSPIFN,YSTIUT,YSTIUTS,G,G2,N,P1,P2,R,V,V1,Y1,YSA,YSAGE,YSAS0,YSASC,YSASD,YSASIG,YSASN,YSASNA,YSASQUIT,YSAST,YSASWP
"RTN","YSASPNT",8,0)
 N YSASWP,YSBID,YSDOB,YSHDR,YSHIML,YSHIMU,YSI,YSJ,YSLAST,YSLCK,YSLFN,YSNM,YSPART,YSPOSL,YSPOSU
"RTN","YSASPNT",9,0)
 N YSPROL,YSPROU,YSSC,YSSCK,YSSEX,YSSSN,YSSTEM,YSTITLE,YSX,YSYCK,YSYX,YSZ,YSZZ,YSV1,YSV2,YSV3,YSV4,YSV5,YSV6,YSV7,YSV8,YSV9,YSV10,YSV11,YSV12,YSV13,YSV14
"RTN","YSASPNT",10,0)
 S Y=$$GET1^DIQ(604,YSASDA,.11,"I") Q:Y'="N"  ;---> out if G12 10/16/01 ASF
"RTN","YSASPNT",11,0)
 S YSTIUT=0,YSTIUTS=0 D ASTIT
"RTN","YSASPNT",12,0)
 I (YSTIUT'>0)!(YSTIUTS'?1"ACT".E) W !,"ASI-TIU not fully ready" Q
"RTN","YSASPNT",13,0)
 K DIR S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do you wish to create a TIU Progress Note" D ^DIR K DIR Q:$D(DIRUT)!(Y'=1)
"RTN","YSASPNT",14,0)
 K DIR S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you wish to automatically sign this note" D ^DIR K DIR Q:$D(DIRUT)  S YSAUTOSG=+Y
"RTN","YSASPNT",15,0)
 D NARSET
"RTN","YSASPNT",16,0)
 D PUTPN
"RTN","YSASPNT",17,0)
 ;
"RTN","YSASPNT",18,0)
 Q
"RTN","YSASPNT",19,0)
ASTIT ;ASI document title check
"RTN","YSASPNT",20,0)
 S X="ASI-ADDICTION SEVERITY INDEX",DIC="^TIU(8925.1,",DIC(0)="M",DIC("S")="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""" D ^DIC K DIC("S") S YSTIUT=+Y Q:YSTIUT'>0
"RTN","YSASPNT",21,0)
 S YSTIUTS=$$GET1^DIQ(8925.1,YSTIUT_",","STATUS")
"RTN","YSASPNT",22,0)
 Q
"RTN","YSASPNT",23,0)
NARSET ;Set up narrative global
"RTN","YSASPNT",24,0)
 S YSZZ=0
"RTN","YSASPNT",25,0)
 S YSAS0=^YSTX(604,YSASDA,0),DFN=$P(YSAS0,"^",2)
"RTN","YSASPNT",26,0)
 D DEM^VADPT
"RTN","YSASPNT",27,0)
 S YSASD=$$FMTE^XLFDT($P(YSAS0,U,5),"5ZD")
"RTN","YSASPNT",28,0)
 S YSAST=$$GET1^DIQ(604,YSASDA_",",.04)
"RTN","YSASPNT",29,0)
 S YSASC=$$GET1^DIQ(604,YSASDA_",",.09)
"RTN","YSASPNT",30,0)
 S YSASIG=$$GET1^DIQ(604,YSASDA_",",.51,"I")
"RTN","YSASPNT",31,0)
 S YSASAUTH=$$GET1^DIQ(604,YSASDA_",",.09,"I")
"RTN","YSASPNT",32,0)
 S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID"),YSBID=VA("BID")
"RTN","YSASPNT",33,0)
 ;
"RTN","YSASPNT",34,0)
 K ^TMP($J,"YSTMP"),^TMP("TIUP",$J)
"RTN","YSASPNT",35,0)
 S YSLFN=1,^TMP($J,"YSTMP",0,1,0)=""
"RTN","YSASPNT",36,0)
 D VARPRO^YSASNAR
"RTN","YSASPNT",37,0)
 D R1^YSASNAR
"RTN","YSASPNT",38,0)
 M ^TMP("TIUP",$J)=^TMP($J,"YSTMP",0)
"RTN","YSASPNT",39,0)
 S X="NOW",%DT="T" D ^%DT S YSNOW=Y
"RTN","YSASPNT",40,0)
 S YSLFN=YSLFN-1,^TMP("TIUP",$J,0)="^^"_YSLFN_U_YSLFN_U_YSNOW_U
"RTN","YSASPNT",41,0)
 S YSLFN=0 F  S YSLFN=$O(^TMP("TIUP",$J,YSLFN)) Q:YSLFN'>0  S:^TMP("TIUP",$J,YSLFN,0)?1"|BLANK".E ^TMP("TIUP",$J,YSLFN,0)=""
"RTN","YSASPNT",42,0)
 Q
"RTN","YSASPNT",43,0)
PUTPN ;create Pnote
"RTN","YSASPNT",44,0)
 S YSAUTOSG=$S(YSAUTOSG:YSASAUTH,1:""),TIUASKVS=1
"RTN","YSASPNT",45,0)
 D NEW^TIUPNAPI(.YSPIFN,DFN,YSASAUTH,YSNOW,YSTIUT,"","","",YSAUTOSG,TIUASKVS)
"RTN","YSASPNT",46,0)
 ;VMP OIFO BAY PINES;ELR;YS*5.01*88 ADDED NEXT LINE OF CODE
"RTN","YSASPNT",47,0)
 S:$G(YSPIFN)=-1 YSPIFN=0
"RTN","YSASPNT",48,0)
 W !,$S(+YSPIFN:"Progress Note created",1:"Progress Note has NOT been created - please select the existing appointment") H 1
"RTN","YSASPNT",49,0)
 Q
"RTN","YSCEN")
1^2
"RTN","YSCEN1")
1^3
"RTN","YSCEN10")
1^4
"RTN","YSCEN13")
0^5^B982218
"RTN","YSCEN13",1,0)
YSCEN13 ;ALB/ASF,HIOFO/FT - CANCEL DISCHARGE; 8/15/12 9:53am
"RTN","YSCEN13",2,0)
 ;;5.01;MENTAL HEALTH;**52,60**;Dec 30, 1994;Build 47
"RTN","YSCEN13",3,0)
 ;
"RTN","YSCEN13",4,0)
 ;No external references
"RTN","YSCEN13",5,0)
 ;
"RTN","YSCEN13",6,0)
SETDICS ;  Called by WARD LOC screen of MH Team file (#618.4)
"RTN","YSCEN13",7,0)
 S DIC("S")="X ""K Z F  S Z=+$O(^YSG(""""CEN"""",+$G(Z))) Q:'Z  S Z(0)=^(Z,0),Z(1)=U_$G(^YSG(""""CEN"""",Z,""""ROT""""))_U I +DA=+$P(Z(0),U,9)!(Z(1)[(U_+DA_U)) S Z(2)=1"" I '$G(Z(2))"
"RTN","YSCEN13",8,0)
 Q
"RTN","YSCEN14")
1^6
"RTN","YSCEN2")
1^7
"RTN","YSCEN21")
1^8
"RTN","YSCEN22")
1^9
"RTN","YSCEN23")
1^10
"RTN","YSCEN24")
1^11
"RTN","YSCEN26")
1^12
"RTN","YSCEN3")
1^13
"RTN","YSCEN31")
1^14
"RTN","YSCEN32")
1^15
"RTN","YSCEN33")
1^16
"RTN","YSCEN34")
1^17
"RTN","YSCEN35")
1^18
"RTN","YSCEN36")
1^19
"RTN","YSCEN37")
1^20
"RTN","YSCEN39")
1^21
"RTN","YSCEN4")
1^22
"RTN","YSCEN41")
1^23
"RTN","YSCEN5")
0^24^B5014852
"RTN","YSCEN5",1,0)
YSCEN5 ;ALB/ASF,HIOFO/FT - CENSUS HX ;8/15/12 9:38am
"RTN","YSCEN5",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YSCEN5",3,0)
 ;
"RTN","YSCEN5",4,0)
 ;No external references
"RTN","YSCEN5",5,0)
 ;
"RTN","YSCEN5",6,0)
CROSS ; set logic for AST x-ref in File 618.4
"RTN","YSCEN5",7,0)
 S:'$D(^YSG("INP",DA,6,0)) ^YSG("INP",DA,6,0)="^618.419P^0^0"
"RTN","YSCEN5",8,0)
 L +^YSG("INP",DA,6):DILOCKTM Q:'$T
"RTN","YSCEN5",9,0)
 S N=$P(^YSG("INP",DA,6,0),U,3)+1
"RTN","YSCEN5",10,0)
 I (N>1),$D(^YSG("INP",DA,6,N-1)),(X=+^YSG("INP",DA,6,N-1,0)) S X2=^YSG("INP",DA,6,N-1,0),W1=+^YSG("INP",DA,7),^YSG("INP","AST",9999999-$P(X2,U,2),W1,X,DA)="" L -^YSG("INP",DA,6,0) Q
"RTN","YSCEN5",11,0)
 S ^YSG("INP",DA,6,0)=$P(^YSG("INP",DA,6,0),U,1,2)_U_N_U_($P(^YSG("INP",DA,6,0),U,4)+1) L -^YSG("INP",DA,6)
"RTN","YSCEN5",12,0)
 S W1=+^YSG("INP",DA,7),YSU=X,X="NOW",%DT="T" D ^%DT S X=YSU,YSNOW=9999999-Y,^YSG("INP","AST",YSNOW,W1,X,DA)="" K YSU,YSNOW
"RTN","YSCEN5",13,0)
 S ^YSG("INP",DA,6,N,0)=X_U_Y_U_DUZ,^YSG("INP",DA,6,"B",X,N)=""
"RTN","YSCEN5",14,0)
 Q:'$D(^YSG("SUB",X,1))
"RTN","YSCEN5",15,0)
 Q:'$P(^YSG("SUB",X,1),U,4)  S YSTM8="" F ZZ=1:1 Q:'$D(^YSG("CEN",W1,"ROT"))  S YSTM7=$P(^YSG("CEN",W1,"ROT"),U,ZZ) Q:YSTM7'?1N.N  S:YSTM7'=X YSTM8=YSTM8_YSTM7_U
"RTN","YSCEN5",16,0)
 S ^YSG("CEN",W1,"ROT")=YSTM8_X
"RTN","YSCEN5",17,0)
 Q
"RTN","YSCEN5",18,0)
ENTRY ; set logic for AWC x-ref in File 618.4
"RTN","YSCEN5",19,0)
 S YSW1=+^YSG("INP",DA,7),G=^YSG("INP",DA,0)
"RTN","YSCEN5",20,0)
 I $P(G,U,2) S ^YSG("INP","CP",$P(G,U,2),DA)=""
"RTN","YSCEN5",21,0)
 I $P(G,U,5) S ^YSG("INP","AC",$P(G,U,5),DA)=""
"RTN","YSCEN5",22,0)
 I $P(G,U,6) S ^YSG("INP","ACP",$P(G,U,6),DA)=""
"RTN","YSCEN5",23,0)
 I $P(G,U,7) S ^YSG("INP","ACR",$P(G,U,7),DA)=""
"RTN","YSCEN5",24,0)
 S ^YSG("INP","AWC",YSW1,X,DA)="" Q
"RTN","YSCEN5",25,0)
LEAVE ; kill logic for AWC x-ref in File 618.4
"RTN","YSCEN5",26,0)
 S YSW1=+^YSG("INP",DA,7),G=^YSG("INP",DA,0)
"RTN","YSCEN5",27,0)
 I $P(G,U,2) K ^YSG("INP","CP",$P(G,U,2),DA)
"RTN","YSCEN5",28,0)
 I $P(G,U,5) K ^YSG("INP","AC",$P(G,U,5),DA)
"RTN","YSCEN5",29,0)
 I $P(G,U,6) K ^YSG("INP","ACP",$P(G,U,6),DA)
"RTN","YSCEN5",30,0)
 I $P(G,U,7) K ^YSG("INP","ACR",$P(G,U,7),DA)
"RTN","YSCEN5",31,0)
 K ^YSG("INP","AWC",YSW1,X,DA) Q
"RTN","YSCEN51")
1^25
"RTN","YSCEN52")
1^26
"RTN","YSCEN53")
1^27
"RTN","YSCEN54")
1^28
"RTN","YSCEN55")
1^29
"RTN","YSCEN56")
1^30
"RTN","YSCEN6")
1^31
"RTN","YSCEN61")
1^32
"RTN","YSCEN7")
1^33
"RTN","YSCEN8")
1^34
"RTN","YSCEN81")
1^35
"RTN","YSCPAF")
1^159
"RTN","YSCPAG")
1^160
"RTN","YSCPAI")
1^161
"RTN","YSCPAK")
1^162
"RTN","YSCPAL")
1^163
"RTN","YSCPAM")
1^164
"RTN","YSCPAQ")
1^165
"RTN","YSCUP")
1^37
"RTN","YSCUP000")
1^38
"RTN","YSCUP001")
1^39
"RTN","YSCUP002")
1^40
"RTN","YSCUP003")
1^41
"RTN","YSCUP004")
1^42
"RTN","YSD40030")
1^166
"RTN","YSD40031")
1^167
"RTN","YSD40032")
1^168
"RTN","YSD40040")
1^169
"RTN","YSD40041")
1^170
"RTN","YSD40042")
1^171
"RTN","YSD40050")
1^172
"RTN","YSD40051")
1^173
"RTN","YSD40052")
1^174
"RTN","YSD40060")
1^175
"RTN","YSD40061")
1^176
"RTN","YSD40062")
1^177
"RTN","YSD4C000")
1^178
"RTN","YSD4CK00")
1^179
"RTN","YSD4DSM")
1^180
"RTN","YSD4E010")
1^181
"RTN","YSD4E020")
1^182
"RTN","YSD4POS0")
1^183
"RTN","YSD4POST")
1^223
"RTN","YSD4PRE")
1^184
"RTN","YSD4PRE0")
1^260
"RTN","YSD4UT01")
1^185
"RTN","YSDX0001")
1^226
"RTN","YSDX0002")
1^227
"RTN","YSDX3")
0^228^B10581455
"RTN","YSDX3",1,0)
YSDX3 ;SLC/DJP,HIOFO/FT - Entry of Axis 1 & 2 Diagnoses for the Mental Health Medical Record ;9/20/11 16:58
"RTN","YSDX3",2,0)
 ;;5.01;MENTAL HEALTH;**33,60**;Dec 30, 1994;Build 47
"RTN","YSDX3",3,0)
 ;
"RTN","YSDX3",4,0)
 ; Called from the top by MENU option YSDIAGE
"RTN","YSDX3",5,0)
 ;
"RTN","YSDX3",6,0)
DRIVER ;Controls flow of routine
"RTN","YSDX3",7,0)
 ;D RECORD^YSDX0001("DRIVER^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",8,0)
 D ENTRY I $D(YSQT) D END^YSDX3U Q
"RTN","YSDX3",9,0)
 D ^YSDX3A I $D(YSQT) D END^YSDX3U Q
"RTN","YSDX3",10,0)
 D AXIS4^YSDX3B I $D(YSQT) D END^YSDX3U Q
"RTN","YSDX3",11,0)
 D AXIS5^YSDX3B D END^YSDX3U Q
"RTN","YSDX3",12,0)
ENTRY ;Initial entry of DSM diagnosis
"RTN","YSDX3",13,0)
 ;D RECORD^YSDX0001("ENTRY^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",14,0)
 S:'$D(YSDUZ) YSDUZ=$P(^VA(200,DUZ,0),U) W @IOF,!!?IOM-$L("ENTRY OF DIAGNOSIS")\2,"ENTRY OF DIAGNOSIS",!! K YSQT D ^YSLRP Q:$D(YSPLIC)  I YSTOUT!YSUOUT!(YSDFN'>0) Q
"RTN","YSDX3",15,0)
 ;
"RTN","YSDX3",16,0)
 ;OLD ;  Called by routine YSCEN1
"RTN","YSDX3",17,0)
 ;Check for diagnosis formulated under DSM-III (File ^MR)
"RTN","YSDX3",18,0)
 ;D RECORD^YSDX0001("OLD^YSDX3") ;Used for testing.  Inactivated in YSDX0001
"RTN","YSDX3",19,0)
 ;I $D(^MR(YSDFN,"DX")) D OLDP
"RTN","YSDX3",20,0)
AGAIN ;  called from routine YSDX3UA
"RTN","YSDX3",21,0)
 ;D RECORD^YSDX0001("AGAIN^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",22,0)
 S P1=0,YSAX=1,YSDTY="A" W !!,"ACTIVE DSM (Axes 1 and 2): ",! D LIST^YSDX3U G:$D(YSNO) QUES1 I '$D(YSDXN) W !!?5,"No active DSM diagnoses on file for ",YSNM,".",!
"RTN","YSDX3",23,0)
 K % D INQ^YSDX3U Q:$D(YSQT)
"RTN","YSDX3",24,0)
 ;
"RTN","YSDX3",25,0)
QUES1 ;Subroutine presents questions for Axes 1&2
"RTN","YSDX3",26,0)
 ;D RECORD^YSDX0001("QUES1^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",27,0)
 I '$D(^XUSEC("YSQ",DUZ)) W !!,"You must hold the YSQ security key to enter a DSM diagnosis." H 3 Q
"RTN","YSDX3",28,0)
 K YSQT W !!,"Enter DSM DIAGNOSIS:  " R X1:DTIME S YSTOUT='$T,YSUOUT=X1["^" I YSTOUT!YSUOUT S YSQT=1 Q
"RTN","YSDX3",29,0)
 Q:X1=""  I X1?.N I X1<(P1+1) G:X1<1 QUES1 W ! D DSMP^YSDX3UA G:'$D(YSY) QUES1 S:$D(S2) YSDXDA=+S2
"RTN","YSDX3",30,0)
 I '$D(YSY) S X=$$UP^XLFSTR(X1) D DSMLK^YSDX3UA G:Y<0 QUES1
"RTN","YSDX3",31,0)
 ;
"RTN","YSDX3",32,0)
DUPLCK ;Checks for and displays possible duplicate entries
"RTN","YSDX3",33,0)
 ;D RECORD^YSDX0001("DUPLCK^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",34,0)
 S:'$D(YSDXDA) YSDXDA=+Y S:'$D(S2) S2=+Y S W2="",W1=S2_";"_"YSD(627.7," F  S W2=$O(^YSD(627.8,"AG","D",YSDFN,W1,W2)) Q:W2=""  S YSDUPDA=W2 D DUPL^YSDX3UA
"RTN","YSDX3",35,0)
CORR ;
"RTN","YSDX3",36,0)
 ;D RECORD^YSDX0001("CORR^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",37,0)
 S YSWN=$P(^YSD(627.7,+YSDXDA,0),U),YSW=$G(^YSD(627.7,+YSDXDA,"D"))
"RTN","YSDX3",38,0)
 S %=0 F  Q:$G(%)  W !!?10,YSWN_" "_YSW,!!,"Is this the DSM Dx you wish to select" S %=2 D
"RTN","YSDX3",39,0)
 .D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT Q 
"RTN","YSDX3",40,0)
 .I '% W !!,"""YES"" indicates the diagnosis entered applies to ",YSNM,"."
"RTN","YSDX3",41,0)
 I %=2 K YSDXDA,X1,YSDXST,YSLC,YSLCN,YSW,YSWN,YSY,S1,S2,S3,YSDXD,YSDXDA1,YSDXDT,YSDXND,YSDTY,W1,W2,W3,W4,W5 G QUES1
"RTN","YSDX3",42,0)
 I %=-1 Q
"RTN","YSDX3",43,0)
FILE ;
"RTN","YSDX3",44,0)
 ;D RECORD^YSDX0001("FILE^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",45,0)
 ;S DIC="^YSD(627.8,",DIC(0)="L",X="""N""",DLAYGO=627 D ^DIC D:Y<0 END^YSDX3U S YSDA=+Y,YSDXDA=YSDXDA_";YSD(627.7,"
"RTN","YSDX3",46,0)
 K DD,DO,DA,DINUM
"RTN","YSDX3",47,0)
 S X="NOW",%DT="TR" D ^%DT S X=Y
"RTN","YSDX3",48,0)
 S DIC="^YSD(627.8,",DIC(0)="L",DLAYGO=627.8 D FILE^DICN D:Y<0 END^YSDX3U S YSDA=+Y,YSDXDA=YSDXDA_";YSD(627.7,"
"RTN","YSDX3",49,0)
 S YSDXDA1=$P(YSDXDA,";") D MODIF^YSDX3UB G:$D(YSQT) QUES1
"RTN","YSDX3",50,0)
 D FILE^YSDX3UA
"RTN","YSDX3",51,0)
 K DO,F1,F2,F3,K1,K2,K3,K4,K5,K6,L2,L3,L4,L5,L7,P2,P3,P4,P5,S2,W1,W2,W3,W4,W5,W6,X,X1,YSDA,YSDTY,YSDXDA,YSDXDA1,YSDXDT,YSDXN,YSDXNN,YSDXST,YSMOD,YSW,YSWN,YSY
"RTN","YSDX3",52,0)
 G QUES1
"RTN","YSDX3",53,0)
 ;
"RTN","YSDX3",54,0)
 ;OLDP ;
"RTN","YSDX3",55,0)
 ;D RECORD^YSDX0001("OLDP^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",56,0)
 ;S %=0 F  Q:$G(%)  W !!,"This patient has diagnoses formulated under DSM-III criteria.",!,"Do you wish to review" S %=2 D
"RTN","YSDX3",57,0)
 ;.D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
"RTN","YSDX3",58,0)
 ;.I '% W !!,"""YES"" provides a list of diagnoses which you may want to reformulate under",!," DSM criteria.  ""NO"" will permit the option to continue.",!
"RTN","YSDX3",59,0)
 ;Q:YSTOUT!YSUOUT  I %'=1 Q
"RTN","YSDX3",60,0)
 ;W !!,"The following may require reformulation under DSM criteria.",! D ^YSDXR
"RTN","YSDX3",61,0)
 ;Q
"RTN","YSDX3",62,0)
 ;
"RTN","YSDX3",63,0)
 ;EN ;The following are entry points used for accessing the DSM routines from options other than YSDIAG.
"RTN","YSDX3",64,0)
 ;
"RTN","YSDX3",65,0)
 ;ENPLDX ; Called by MENU option YSPLDX
"RTN","YSDX3",66,0)
 ; Called by routines YSPROB, YSPROB1, YSPROB3
"RTN","YSDX3",67,0)
 ;D RECORD^YSDX0001("ENPLDX^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",68,0)
 ;S YSPLDX=1,N1=0 D @$S($D(YSDFN):"OLD",1:"ENTRY") I $G(YSQT)!YSTOUT!YSUOUT!(YSDFN'>0) D END^YSDX3U Q
"RTN","YSDX3",69,0)
 ;D AXIS4^YSDX3B I $D(YSQT) D END^YSDX3U Q
"RTN","YSDX3",70,0)
 ;D AXIS5^YSDX3B I $D(YSQT) D END^YSDX3U
"RTN","YSDX3",71,0)
 ;Q
"RTN","YSDX3",72,0)
 ;
"RTN","YSDX3",73,0)
 ;ENPLIC ; Called by MENU option YSPLPDX
"RTN","YSDX3",74,0)
 ;  Called by routines YSPROB1, YSPROB3
"RTN","YSDX3",75,0)
 ;
"RTN","YSDX3",76,0)
 ;D RECORD^YSDX0001("ENPLIC^YSDX3") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3",77,0)
 ;S YSPLIC=1,N1=0 S:'$D(YSDUZ) YSDUZ=$P(^VA(200,DUZ,0),U) D:$G(YSDFN)'>0 ^YSLRP I YSTOUT!YSUOUT!(YSDFN'>0) D END^YSDX3U Q
"RTN","YSDX3",78,0)
 ;D ^YSDX3A D END^YSDX3U Q
"RTN","YSDX3UA")
0^234^B17115146
"RTN","YSDX3UA",1,0)
YSDX3UA ;SLC/DJP/LJA,HIOFO/FT - Utilities for Diagnosis Entry in the MH Medical Record (cont.) ;10/21/11 1:24pm
"RTN","YSDX3UA",2,0)
 ;;5.01;MENTAL HEALTH;**96,60**;Dec 30, 1994;Build 47
"RTN","YSDX3UA",3,0)
 ;
"RTN","YSDX3UA",4,0)
 ;Reference to ^VA(200, supported by DBIA #10060
"RTN","YSDX3UA",5,0)
 ;Reference to ^ICD9( supported by DBIA #5388
"RTN","YSDX3UA",6,0)
 ;Reference to ^ICDCODE APIs supported by DBIA #3990
"RTN","YSDX3UA",7,0)
 ;
"RTN","YSDX3UA",8,0)
 ;
"RTN","YSDX3UA",9,0)
DSMLK ; Called by routine YSDX3
"RTN","YSDX3UA",10,0)
 ; Keyword lookup for DSM
"RTN","YSDX3UA",11,0)
 ; naked reference to ^YSD(627.7,D0,0)
"RTN","YSDX3UA",12,0)
 S DIC("S")="I $P(^(0),U,2)=4" ; Allow DSM-IV selection only
"RTN","YSDX3UA",13,0)
 S DIC(0)="QMZE",DIC="^YSD(627.7,"
"RTN","YSDX3UA",14,0)
 D ^DIC
"RTN","YSDX3UA",15,0)
 K DIC("S")
"RTN","YSDX3UA",16,0)
 Q
"RTN","YSDX3UA",17,0)
 ;
"RTN","YSDX3UA",18,0)
DSMP ; Called by routine YSDX3
"RTN","YSDX3UA",19,0)
 ;D RECORD^YSDX0001("DSMP^YSDX3UA") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3UA",20,0)
 I '$D(P2) W " ?? " W @IOF G AGAIN^YSDX3
"RTN","YSDX3UA",21,0)
 S S1=$P(^YSD(627.8,P2(X1),1),U),S2=$P(S1,";"),YSY=1
"RTN","YSDX3UA",22,0)
 QUIT
"RTN","YSDX3UA",23,0)
 ;
"RTN","YSDX3UA",24,0)
 ;
"RTN","YSDX3UA",25,0)
ICDLK ; Called from YSDX3A
"RTN","YSDX3UA",26,0)
 ; Lookup on the ICD9 File
"RTN","YSDX3UA",27,0)
 S X=$P(X2," ") G:$P(X2," ",2)="" ICD1
"RTN","YSDX3UA",28,0)
 ; naked reference to ^ICD9(D0,1) for (#10) DESCRIPTION [1F]
"RTN","YSDX3UA",29,0)
 S Q=$C(34),D="S A=$C(32)_^(1) I "
"RTN","YSDX3UA",30,0)
 F I=2:1 S B=$P(X2," ",I) Q:B=""  S:B'[Q D=D_"(A["" "_B_""")&"
"RTN","YSDX3UA",31,0)
 S DIC("S")=$E(D,1,$L(D)-1)
"RTN","YSDX3UA",32,0)
ICD1 ;
"RTN","YSDX3UA",33,0)
 S X=X2,DIC(0)="QMZE",DIC="^ICD9("
"RTN","YSDX3UA",34,0)
 D ^DIC
"RTN","YSDX3UA",35,0)
 K DIC("S")
"RTN","YSDX3UA",36,0)
 QUIT
"RTN","YSDX3UA",37,0)
 ;
"RTN","YSDX3UA",38,0)
ICDP ; Called by routine YSDX3A
"RTN","YSDX3UA",39,0)
 ;D RECORD^YSDX0001("ICDP^YSDX3UA") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3UA",40,0)
 S S1=$P(^YSD(627.8,P2(X2),1),U),S2=$$ICDDX^ICDCODE($P(S1,";")),S2=$P(S2,U,2),YSY=1 ;ASF 04/10/09
"RTN","YSDX3UA",41,0)
 QUIT
"RTN","YSDX3UA",42,0)
 ;
"RTN","YSDX3UA",43,0)
DXLS D DXLS^YSDX3UA0
"RTN","YSDX3UA",44,0)
 QUIT
"RTN","YSDX3UA",45,0)
 ;
"RTN","YSDX3UA",46,0)
DXLSQ D DXLSQ^YSDX3UA0
"RTN","YSDX3UA",47,0)
 QUIT
"RTN","YSDX3UA",48,0)
 ;
"RTN","YSDX3UA",49,0)
DUPL ; Called by routine YSDX3, YSDX3A
"RTN","YSDX3UA",50,0)
 ; Print out information concerning duplicate entry
"RTN","YSDX3UA",51,0)
 ;D RECORD^YSDX0001("DUPL^YSDX3UA") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3UA",52,0)
 S W3=$P(^VA(200,$P(^YSD(627.8,W2,0),U,4),0),U)
"RTN","YSDX3UA",53,0)
 N YSDZX
"RTN","YSDX3UA",54,0)
 S Y=$P(^YSD(627.8,W2,0),U,3) D DD^%DT S W4=Y
"RTN","YSDX3UA",55,0)
 I YSAX=1 S YSDXND=$P(^YSD(627.7,S2,0),U),YSDXD=$P(^(0),U)
"RTN","YSDX3UA",56,0)
 I YSAX=3 S YSDXD=$P(^ICD9(S2,0),U) N YSDXZ S YSDZX=$$ICDD^ICDCODE(YSDXD,"YSDZX"),YSDXND=YSDZX(1) ;asf 04/10/09
"RTN","YSDX3UA",57,0)
 S W5=$P(^YSD(627.8,W2,1),U,2)
"RTN","YSDX3UA",58,0)
 I W5="i" K YSDXND,YSDXD,W3,W4,W5 QUIT  ;->
"RTN","YSDX3UA",59,0)
 S W6=$S(W5="v":"VERIFIED",W5="p":"PROVISIONAL",W5="i":"INACTIVE",W5="r":"REFORMULATED",W5="n":"NOT FOUND",W5="ru":"RULE OUT",1:"")
"RTN","YSDX3UA",60,0)
DUPLP ;
"RTN","YSDX3UA",61,0)
 ;D RECORD^YSDX0001("DUPLP^YSDX3UA") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3UA",62,0)
 I '$D(YSF1) D
"RTN","YSDX3UA",63,0)
 .  W !!,"This diagnosis has been entered as follows:  "
"RTN","YSDX3UA",64,0)
 .  W !!?5,"DIAGNOSIS: ",?15,YSDXND_" "_YSDXD,!?5,"STATUS:"
"RTN","YSDX3UA",65,0)
 .  W ?13,W6,!?5,"BY:",?13,$E(W3,1,25)_" on "_W4,!
"RTN","YSDX3UA",66,0)
 S YSF1=1
"RTN","YSDX3UA",67,0)
 QUIT
"RTN","YSDX3UA",68,0)
 ;
"RTN","YSDX3UA",69,0)
FILE ; Called from routines YSDX3, YSDX3A
"RTN","YSDX3UA",70,0)
 ;D RECORD^YSDX0001("FILE^YSDX3UA") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3UA",71,0)
 S YSDUZ=$P(^VA(200,DUZ,0),U)
"RTN","YSDX3UA",72,0)
 W !
"RTN","YSDX3UA",73,0)
 S DIE=DIC,DA=YSDA,DR=".02///"_YSDFN_";.03//NOW;.04//"_YSDUZ_";.05///^S X=""`""_DUZ;1///^S X=YSDXDA;5"
"RTN","YSDX3UA",74,0)
 L +@(DIE_"DA)"):DILOCKTM
"RTN","YSDX3UA",75,0)
 I '$T D ERRMSG^YSSITE,DELETE Q
"RTN","YSDX3UA",76,0)
 D ^DIE
"RTN","YSDX3UA",77,0)
 L -@(DIE_"DA)")
"RTN","YSDX3UA",78,0)
 S YSTOUT=$D(DTOUT) I YSTOUT D DELETE QUIT  ;->
"RTN","YSDX3UA",79,0)
 D CHECK QUIT:YSUOUT  ;->
"RTN","YSDX3UA",80,0)
 S C1=$P(^YSD(627.8,YSDA,1),U,2)
"RTN","YSDX3UA",81,0)
 I C1="" W !!?18,"Incomplete information." D DELETE QUIT  ;->
"RTN","YSDX3UA",82,0)
 S C2=$S(C1="v":"A",C1="p":"A",C1="i":"I",C1="r":"I",C1="n":"I",C1="ru":"A",1:"I")
"RTN","YSDX3UA",83,0)
 S DIE="^YSD(627.8,",DA=YSDA,DR="7///^S X=C2;8///NOW"
"RTN","YSDX3UA",84,0)
 L +^YSD(627.8,DA):DILOCKTM
"RTN","YSDX3UA",85,0)
 I '$T D ERRMSG^YSSITE Q
"RTN","YSDX3UA",86,0)
 D ^DIE
"RTN","YSDX3UA",87,0)
 L -^YSD(627.8,DA)
"RTN","YSDX3UA",88,0)
 K DIE
"RTN","YSDX3UA",89,0)
 S YSTOUT=$D(DTOUT) I YSTOUT QUIT  ;->
"RTN","YSDX3UA",90,0)
 D CHECK QUIT:YSUOUT  ;->
"RTN","YSDX3UA",91,0)
 N YSTO S YSTO=0
"RTN","YSDX3UA",92,0)
 I $D(W3) D  Q:YSTO
"RTN","YSDX3UA",93,0)
 .  S DIE="^YSD(627.8,",DA=YSDUPDA
"RTN","YSDX3UA",94,0)
 .  S DR="7///^S X=""I"";8///NOW;9///^S X=""Y"""
"RTN","YSDX3UA",95,0)
 .  L +^YSD(627.8,DA):DILOCKTM
"RTN","YSDX3UA",96,0)
 .  I '$T D ERRMSG^YSSITE S YSTO=1 Q
"RTN","YSDX3UA",97,0)
 .  D ^DIE
"RTN","YSDX3UA",98,0)
 .  L -^YSD(627.8,DA)
"RTN","YSDX3UA",99,0)
 D DXLS,DXLSQ
"RTN","YSDX3UA",100,0)
 S DIE="^YSD(627.8,",DA=YSDA
"RTN","YSDX3UA",101,0)
 S DR="10///^S X=YSDXLX;80"
"RTN","YSDX3UA",102,0)
 L +^YSD(627.8,DA):DILOCKTM
"RTN","YSDX3UA",103,0)
 I '$T D ERRMSG^YSSITE Q
"RTN","YSDX3UA",104,0)
 D ^DIE
"RTN","YSDX3UA",105,0)
 L -^YSD(627.8,DA)
"RTN","YSDX3UA",106,0)
 S YSTOUT=$D(DTOUT) QUIT:YSTOUT  ;->
"RTN","YSDX3UA",107,0)
 D CHECK QUIT:YSUOUT  ;->
"RTN","YSDX3UA",108,0)
FILEQ ;
"RTN","YSDX3UA",109,0)
 ;D RECORD^YSDX0001("FILEQ^YSDX3UA") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3UA",110,0)
 S %=0
"RTN","YSDX3UA",111,0)
 F  Q:$G(%)  W !!," Do you want to record this diagnosis" S %=1 D
"RTN","YSDX3UA",112,0)
 .  D YN^DICN
"RTN","YSDX3UA",113,0)
 .  I '% W !!,"NO will delete this entry.  YES will file it under the patient's name."
"RTN","YSDX3UA",114,0)
 I %=2!(%=-1) D DELETE
"RTN","YSDX3UA",115,0)
 QUIT
"RTN","YSDX3UA",116,0)
 ;
"RTN","YSDX3UA",117,0)
CHECK ;
"RTN","YSDX3UA",118,0)
 ;D RECORD^YSDX0001("CHECK^YSDX3UA") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3UA",119,0)
 S YSUOUT=$O(Y(""))]"" I 'YSUOUT QUIT  ;->
"RTN","YSDX3UA",120,0)
 W !!?18,"Incomplete information."
"RTN","YSDX3UA",121,0)
 ;
"RTN","YSDX3UA",122,0)
DELETE ; Called by routine YSDX3UB
"RTN","YSDX3UA",123,0)
 ;D RECORD^YSDX0001("DELETE^YSDX3UA") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDX3UA",124,0)
 S DIK="^YSD(627.8,",DA=YSDA
"RTN","YSDX3UA",125,0)
 D ^DIK
"RTN","YSDX3UA",126,0)
 W !!?15,"< This diagnosis deleted. >"
"RTN","YSDX3UA",127,0)
 QUIT
"RTN","YSDX3UA",128,0)
 ;
"RTN","YSDX3UA",129,0)
EOR ;YSDX3UA - Utilities for Diagnosis Entry in the MH Medical Record (cont.) ;4/16/92 11:17
"RTN","YSDXR")
0^229^B3156016
"RTN","YSDXR",1,0)
YSDXR ;SLC/DKG/RWF/ASF/LJA,HIOFO/FT - (DSM-III) DIAGNOSIS REPORT ;9/20/11 16:37
"RTN","YSDXR",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YSDXR",3,0)
 ;
"RTN","YSDXR",4,0)
 ;D RECORD^YSDX0001("^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",5,0)
 ;  Called by routine YSDX3
"RTN","YSDXR",6,0)
1 ;
"RTN","YSDXR",7,0)
 ;D RECORD^YSDX0001("1^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",8,0)
 R !,"SORT BY (D)IAGNOSIS or (C)HRONOLOGICALLY?  D// ",A:DTIME
"RTN","YSDXR",9,0)
 S YSTOUT='$T,YSUOUT=A["^"
"RTN","YSDXR",10,0)
 QUIT:YSTOUT!YSUOUT  ;->
"RTN","YSDXR",11,0)
 S A=$TR($E(A_"D"),"cd","CD")
"RTN","YSDXR",12,0)
 I "DC"'[A W:A'["?" " ?",$C(7) G 1 ;->
"RTN","YSDXR",13,0)
2 ;
"RTN","YSDXR",14,0)
 ;D RECORD^YSDX0001("2^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",15,0)
 R !,"LIST ONLY ACTIVE DIAGNOSIS?  N// ",A1:DTIME
"RTN","YSDXR",16,0)
 S YSTOUT='$T,YSUOUT=A1["^"
"RTN","YSDXR",17,0)
 QUIT:YSTOUT!YSUOUT  ;->
"RTN","YSDXR",18,0)
 S A1=$TR($E(A1_"N"),"yn","YN")
"RTN","YSDXR",19,0)
 I "NY"'[A1 W:A1'["?" " ?",$C(7) G 2 ;->
"RTN","YSDXR",20,0)
 K IOP S ZTSK="",%ZIS="Q" D ^%ZIS QUIT:POP  ;->
"RTN","YSDXR",21,0)
 I $D(IO("Q")) D  QUIT
"RTN","YSDXR",22,0)
 .  S ZTRTN="ENPR^YSDXR"
"RTN","YSDXR",23,0)
 .  S (ZTSAVE("A"),ZTSAVE("A1"),ZTSAVE("YS*"))=""
"RTN","YSDXR",24,0)
 .  S ZTDESC="YS DSM3 PRINT"
"RTN","YSDXR",25,0)
 .  D ^%ZTLOAD
"RTN","YSDXR",26,0)
 ;
"RTN","YSDXR",27,0)
ENPR ;
"RTN","YSDXR",28,0)
 ;D RECORD^YSDX0001("ENPR^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",29,0)
 S YSFHDR="Diagnosis List"
"RTN","YSDXR",30,0)
 S YSFHDR(1)="W !,""DSM/ICD"",?8,""TITLE"" X YSFHDR(2),YSFHDR(3)",YSFHDR(2)="I $D(A1),A1?1""Y"".E W ?30,""**** ONLY ACTIVE DIAGNOSIS ****""",YSFHDR(3)="W !,""CODE"",?10,""DATE"""
"RTN","YSDXR",31,0)
 S YSPP=0
"RTN","YSDXR",32,0)
PR ;
"RTN","YSDXR",33,0)
 ;D RECORD^YSDX0001("PR^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",34,0)
 U IO
"RTN","YSDXR",35,0)
 D:'$D(YSNOFORM) ENHD^YSFORM
"RTN","YSDXR",36,0)
 S Y1=0,T=0,YST=$S(IOST?1"P".E:1,1:0),YSSL=$S(YST:8,1:3),YSLFT=0
"RTN","YSDXR",37,0)
 W !
"RTN","YSDXR",38,0)
 ;
"RTN","YSDXR",39,0)
 ;  Principal DSM-III Diagnosis
"RTN","YSDXR",40,0)
 ;I $D(^MR(YSDFN,"DX1")),+^("DX1")?7N.E,$P(^("DX1"),U,2)?1N.E D
"RTN","YSDXR",41,0)
 ;.  S X(1)=^MR(YSDFN,"DX1")
"RTN","YSDXR",42,0)
 ;.  W !,"DXLS (DSM-III): ",$P(^YSD(627.7,+$P(X(1),U,2),0),U,2)
"RTN","YSDXR",43,0)
 ;.  W " ON" S X=+X(1) D DAT
"RTN","YSDXR",44,0)
 ;
"RTN","YSDXR",45,0)
 ;  Principal ICD9 Diagnosis
"RTN","YSDXR",46,0)
 ;I $D(^MR(YSDFN,"DX2")),+^("DX2")?7N.E,$P(^("DX2"),U,2)?1N.E D
"RTN","YSDXR",47,0)
 ;.  S X(1)=^MR(YSDFN,"DX2")
"RTN","YSDXR",48,0)
 ;.  W !,"DXLS (ICD9): ",$P(^ICD9($P(X(1),U,2),0),U)
"RTN","YSDXR",49,0)
 ;.  W " ON" S X=+X(1) D DAT
"RTN","YSDXR",50,0)
 ;
"RTN","YSDXR",51,0)
 ;  X DSM-III Diagnosis
"RTN","YSDXR",52,0)
 ;I $D(^MR(YSDFN,"DX1")),$P(^("DX1"),U,3)?7N.E,$P(^("DX1"),U,4)?1N.E D
"RTN","YSDXR",53,0)
 ;.  S X(1)=^MR(YSDFN,"DX1")
"RTN","YSDXR",54,0)
 ;.  W !,"'X' DIAGNOSIS (DSM-III): ",$P(^YSD(627.7,$P(X(1),U,4),0),U,2)
"RTN","YSDXR",55,0)
 ;.  W " ON" S X=$P(^MR(YSDFN,"DX1"),U,3) D DAT
"RTN","YSDXR",56,0)
 ;
"RTN","YSDXR",57,0)
 ;  X ICD9 Diagnosis
"RTN","YSDXR",58,0)
 ;I $D(^MR(YSDFN,"DX2")),$P(^("DX2"),U,3)?7N.E,$P(^("DX2"),U,4)?1N.E D
"RTN","YSDXR",59,0)
 ;.  S X(1)=^MR(YSDFN,"DX2")
"RTN","YSDXR",60,0)
 ;.  W !,"'X' DIAGNOSIS (ICD9): ",$P(^ICD9($P(X(1),U,4),0),U)
"RTN","YSDXR",61,0)
 ;.  W " ON" S X=$P(^MR(YSDFN,"DX2"),U,3) D DAT
"RTN","YSDXR",62,0)
 ;
"RTN","YSDXR",63,0)
 ;  DSM-III Diagnosis
"RTN","YSDXR",64,0)
 ;I $D(^MR(YSDFN,"DX",1)) W !!,"DSM-III DIAGNOSES:"
"RTN","YSDXR",65,0)
 ;I $D(A) G:A?1"C".E ^YSDXR1 ;->
"RTN","YSDXR",66,0)
 ;PRT ;
"RTN","YSDXR",67,0)
 ;D RECORD^YSDX0001("PRT^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",68,0)
 ;S T=$O(^MR(YSDFN,"DX","B",T))
"RTN","YSDXR",69,0)
 ;G PRE:'T ;->
"RTN","YSDXR",70,0)
 ;S Y1=$O(^MR(+YSDFN,"DX","B",T,0))
"RTN","YSDXR",71,0)
 ;G PRE:'Y1 ;->
"RTN","YSDXR",72,0)
 ;S D2=^MR(YSDFN,"DX",+Y1,0),T1=0
"RTN","YSDXR",73,0)
 ;G PRT:(D2<1) ;->
"RTN","YSDXR",74,0)
 ;S Y2=^YSD(627.7,+D2,0)
"RTN","YSDXR",75,0)
 ;I $D(A1),A1?1"Y".E G PRT:$P(D2,U,2)="I" ;->
"RTN","YSDXR",76,0)
 ;I $Y+YSSL+2>IOSL D CK QUIT:YSLFT  ;->
"RTN","YSDXR",77,0)
 ;W !!,$P(Y2,U,2),?8
"RTN","YSDXR",78,0)
 ;S Y2=$P(Y2,U)
"RTN","YSDXR",79,0)
 ;F I=3:1:8 I $L($P(Y2," ",I))>70 QUIT
"RTN","YSDXR",80,0)
 ;W $P(Y2," ",1,I-1) W:$L($P(Y2," ",I,99)) !?9,$P(Y2," ",I,99)
"RTN","YSDXR",81,0)
 ;S C=$P(^MR(YSDFN,"DX",Y1,0),U,2)
"RTN","YSDXR",82,0)
 ;S C=$S(C="A":"A C T I V E",C="I":"** INACTIVE",1:"")
"RTN","YSDXR",83,0)
 ;W "  ",C
"RTN","YSDXR",84,0)
 ;PT1 ;
"RTN","YSDXR",85,0)
 ;D RECORD^YSDX0001("PT1^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",86,0)
 ;I $Y+YSSL+2>IOSL D CK QUIT:YSLFT  ;->
"RTN","YSDXR",87,0)
 ;S T1=$O(^MR(YSDFN,"DX",Y1,1,T1))
"RTN","YSDXR",88,0)
 ;G PRT:'T1 ;->
"RTN","YSDXR",89,0)
 ;S S2=^MR(YSDFN,"DX",Y1,1,T1,0)
"RTN","YSDXR",90,0)
 ;W !?8 S X=+S2,Z=$P(S2,U,2) D DAT,ENS
"RTN","YSDXR",91,0)
 ;S X=$P(S2,U,3)
"RTN","YSDXR",92,0)
 ;I X>0,$D(^VA(200,X,0)) D
"RTN","YSDXR",93,0)
 ;.  W "  ",$P(^VA(200,X,0),U)
"RTN","YSDXR",94,0)
 ;.  S X=$P(^VA(200,X,0),U,9)
"RTN","YSDXR",95,0)
 ;. I X>0,$D(^DIC(3.1,X,0)) W ", ",^(0)
"RTN","YSDXR",96,0)
 ;S X=$P(S2,U,4)
"RTN","YSDXR",97,0)
 ;I $L(X) F I=4:1:10 IF $L($P(X," ",I))>50 QUIT
"RTN","YSDXR",98,0)
 ;I $L(X) D
"RTN","YSDXR",99,0)
 ;.  W !?20,"COMMENT: ",$P(X," ",1,I)
"RTN","YSDXR",100,0)
 ;.  W:$L($P(X," ",I+1,99)) !?21,$P(X," ",I+1,99)
"RTN","YSDXR",101,0)
 ;G PT1
"RTN","YSDXR",102,0)
PRE ;
"RTN","YSDXR",103,0)
 ;D RECORD^YSDX0001("PRE^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",104,0)
 ;D MULT
"RTN","YSDXR",105,0)
 ;I '$D(^MR(YSDFN,"PHDX",1)) G END ;->
"RTN","YSDXR",106,0)
 ;S T=0
"RTN","YSDXR",107,0)
 ;G ^YSPDXR ;->
"RTN","YSDXR",108,0)
 ;
"RTN","YSDXR",109,0)
DAT ;D DAT^YSDXR000 ;->
"RTN","YSDXR",110,0)
 QUIT
"RTN","YSDXR",111,0)
 ;
"RTN","YSDXR",112,0)
ENS ;D ENS^YSDXR000 ;->
"RTN","YSDXR",113,0)
 QUIT
"RTN","YSDXR",114,0)
 ;
"RTN","YSDXR",115,0)
MULT ;D MULT^YSDXR000 ;->
"RTN","YSDXR",116,0)
 QUIT
"RTN","YSDXR",117,0)
 ;
"RTN","YSDXR",118,0)
CK ;D CK^YSDXR000 ;->
"RTN","YSDXR",119,0)
 QUIT
"RTN","YSDXR",120,0)
 ;
"RTN","YSDXR",121,0)
 ;ENPP ;
"RTN","YSDXR",122,0)
 ;D RECORD^YSDX0001("ENPP^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",123,0)
 ;S YSFHDR="DSM/ICDA9 Diagnosis List",YSPP=1
"RTN","YSDXR",124,0)
 ;G PR ;->
"RTN","YSDXR",125,0)
 ;
"RTN","YSDXR",126,0)
 ;END ;
"RTN","YSDXR",127,0)
 ;D RECORD^YSDX0001("END^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
"RTN","YSDXR",128,0)
 ;QUIT:$D(YSNOFORM)  ;->
"RTN","YSDXR",129,0)
 ;D ENFT^YSFORM:YST
"RTN","YSDXR",130,0)
 ;D:'YSPP WAIT^YSUTL:'YST
"RTN","YSDXR",131,0)
 ;QUIT:YSPP  ;->
"RTN","YSDXR",132,0)
 ;D ^%ZISC
"RTN","YSDXR",133,0)
 ;S:$G(ZTSK) ZTREQ="@"
"RTN","YSDXR",134,0)
 ;K:$G(ZTSK) YSCON
"RTN","YSDXR",135,0)
 ;QUIT
"RTN","YSDXR",136,0)
 ;
"RTN","YSDXR",137,0)
 ;EOR ;YSDXR - (DSM-III) DIAGNOSIS REPORT ;12/6/90  11:24
"RTN","YSDXR000")
1^230
"RTN","YSDXR1")
1^231
"RTN","YSEMSG")
1^43
"RTN","YSESA")
1^44
"RTN","YSESD")
1^45
"RTN","YSESE")
1^46
"RTN","YSESED")
1^47
"RTN","YSESH")
1^48
"RTN","YSESL")
1^49
"RTN","YSESLOG")
1^50
"RTN","YSESM")
1^51
"RTN","YSESN")
1^52
"RTN","YSESP")
1^53
"RTN","YSESR")
1^54
"RTN","YSESUT")
1^55
"RTN","YSGAF3")
0^56^B95532
"RTN","YSGAF3",1,0)
YSGAF3 ;ASF/ALB, HIOFO/FT - GAF CASE FINDER ;9/15/11  9:32 am
"RTN","YSGAF3",2,0)
 ;;5.01;MENTAL HEALTH;**48,49,60**;Dec 30, 1994;Build 47
"RTN","YSGAF3",3,0)
 ;
"RTN","YSGAF3",4,0)
 ;Reference to VASITE supported by DBIA #10112
"RTN","YSGAF3",5,0)
 ;
"RTN","YSGAF3",6,0)
SITE() ;Returns SITE-NAME
"RTN","YSGAF3",7,0)
 N YSDA
"RTN","YSGAF3",8,0)
 S YSDA=+$P($$SITE^VASITE,U,3)
"RTN","YSGAF3",9,0)
 Q $$GET1^DIQ(4,YSDA_",",.01)
"RTN","YSGAF3",10,0)
 ;
"RTN","YSHELP")
1^57
"RTN","YSHX1")
1^186
"RTN","YSHX1R")
1^187
"RTN","YSJOB")
1^58
"RTN","YSJOBK")
1^59
"RTN","YSKFASI1")
1^188
"RTN","YSKFASI2")
1^189
"RTN","YSKFASIF")
1^190
"RTN","YSKFASIM")
1^60
"RTN","YSLOCN")
0^238^B1428676
"RTN","YSLOCN",1,0)
YSLOCN ;SLC/TGA,SLC/DKG,HIOFO/FT,HIOFO/hrubovcak-SITE NUMBER AND NAME ;9/20/11 14:27
"RTN","YSLOCN",2,0)
 ;;5.01;MENTAL HEALTH;**70,60**;Dec 30, 1994;Build 47
"RTN","YSLOCN",3,0)
 ;
"RTN","YSLOCN",4,0)
 ;Reference to XPDUTL APIs supported by DBIA #10141
"RTN","YSLOCN",5,0)
 ;Reference to FILE 4 fields supported by DBIA #10090
"RTN","YSLOCN",6,0)
 ;
"RTN","YSLOCN",7,0)
 ; Called as ENTRY action from MENU option YSUSER
"RTN","YSLOCN",8,0)
 ;
"RTN","YSLOCN",9,0)
 S X="** Mental Health version "_$$VERSION^XPDUTL("YS")_" **"
"RTN","YSLOCN",10,0)
 W @IOF,!!,$J(" ",IOM-$L(X)\2)_X,!
"RTN","YSLOCN",11,0)
 ;
"RTN","YSLOCN",12,0)
SITE ;
"RTN","YSLOCN",13,0)
 D:'$D(DUZ(2)) EMSG1 Q:'$D(DUZ(2))  D:DUZ(2)'>0 EMSG1 Q:DUZ(2)'>0
"RTN","YSLOCN",14,0)
 S YSLC=$$GET1^DIQ(4,DUZ(2),"99","I","","YSERR")
"RTN","YSLOCN",15,0)
 S YSLCN="VAMC "_$$GET1^DIQ(4,DUZ(2),".01","I","","YSERR")
"RTN","YSLOCN",16,0)
 K X,Y
"RTN","YSLOCN",17,0)
 D ENDTM^YSUTL
"RTN","YSLOCN",18,0)
 Q
"RTN","YSLOCN",19,0)
EMSG1 ;
"RTN","YSLOCN",20,0)
 S XQUIT=1 W !!,"The DIVISION field in the NEW PERSON file for YOUR user name must be set."
"RTN","YSLOCN",21,0)
 W !,"To continue, please see your SITE manager."_$C(7),! H 3 Q
"RTN","YSLOCN",22,0)
 ;
"RTN","YSLOCN",23,0)
 ; 13 October 2011
"RTN","YSLRP")
0^251^B836128
"RTN","YSLRP",1,0)
YSLRP ;ALB/ASF,HIOFO/FT - LOOKUP PATIENT ;9/12/11 15:29
"RTN","YSLRP",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YSLRP",3,0)
 ;
"RTN","YSLRP",4,0)
 ;Reference to ^DPT( supported by DBIA #10035
"RTN","YSLRP",5,0)
 ;
"RTN","YSLRP",6,0)
 ;Lookup patient
"RTN","YSLRP",7,0)
 ;Called by routines YSDX3, YSDX3R, YSDX3R1, YSGAF, YSGAF1, YSGAF2, YSHX1, YSMV, YSSR, YSSR1
"RTN","YSLRP",8,0)
 ; YTCHECK, YTEXT, YTKIL, YTMBMD, YTMCMI3, YTMMPI2A, YTONLY, YTQAPI14, YTQAPI15
"RTN","YSLRP",9,0)
 N DIC S DIC(0)="ACEQMZ",DIC="^DPT(",YSDFN=-1
"RTN","YSLRP",10,0)
 D ^DIC S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) S:Y>0 YSDFN=+Y,Z1=Y
"RTN","YSLRP",11,0)
 I $D(Y(0)) S:'$D(YSDFN(0)) YSDFN(0)=Y(0)
"RTN","YSLRP",12,0)
 I YSTOUT!YSUOUT!(YSDFN'>0) S YSQT=1 Q
"RTN","YSLRP",13,0)
PTVAR ;Patient Variables
"RTN","YSLRP",14,0)
 S DFN=YSDFN D DEM^VADPT,PID^VADPT
"RTN","YSLRP",15,0)
 S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID")
"RTN","YSLRP",16,0)
END ;
"RTN","YSLRP",17,0)
 Q
"RTN","YSLRP",18,0)
 ;
"RTN","YSMHMENU")
0^253^B571680
"RTN","YSMHMENU",1,0)
YSMHMENU ;SLC/TGA,HIOFO/hrubovcak-MENTAL HEALTH MENU HEADINGS ;10/25/11 9:10am
"RTN","YSMHMENU",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YSMHMENU",3,0)
 ;
"RTN","YSMHMENU",4,0)
 Q
"RTN","YSMHMENU",5,0)
 ;
"RTN","YSMHMENU",6,0)
CLIN ; Called as ENTRY action in option YSCLINRECORD
"RTN","YSMHMENU",7,0)
 N H2,L2 S H2="*** MENTAL HEALTH ***",L2="Clinical Record" D WRT
"RTN","YSMHMENU",8,0)
 Q
"RTN","YSMHMENU",9,0)
 ;
"RTN","YSMHMENU",10,0)
MHS ; Called as ENTRY action in option YSMANAGER
"RTN","YSMHMENU",11,0)
 N H2,L2 S H2="*** MENTAL HEALTH ***",L2="MHS Manager Functions" D WRT
"RTN","YSMHMENU",12,0)
 Q
"RTN","YSMHMENU",13,0)
 ;
"RTN","YSMHMENU",14,0)
WRT ;
"RTN","YSMHMENU",15,0)
 W @IOF,$J(" ",IOM-$L(H2)\2)_H2,!,$J(" ",IOM-$L(L2)\2)_L2
"RTN","YSMHMENU",16,0)
 Q
"RTN","YSMHMENU",17,0)
 ; 13 October 2011
"RTN","YSMHMENU",18,0)
 ;
"RTN","YSMV")
1^191
"RTN","YSMV1")
1^192
"RTN","YSNTEG")
1^261
"RTN","YSNTEG0")
1^263
"RTN","YSONIT")
1^193
"RTN","YSONIT1")
1^194
"RTN","YSONIT2")
1^195
"RTN","YSONIT3")
1^196
"RTN","YSPDR1")
1^232
"RTN","YSPDXR")
1^233
"RTN","YSPHY")
1^61
"RTN","YSPHY1")
1^62
"RTN","YSPHYR")
1^63
"RTN","YSPP")
1^64
"RTN","YSPP1")
1^65
"RTN","YSPP1A")
1^262
"RTN","YSPP2")
1^66
"RTN","YSPP3")
1^67
"RTN","YSPP4")
1^68
"RTN","YSPP5")
1^69
"RTN","YSPP6")
1^70
"RTN","YSPP7")
1^71
"RTN","YSPP8")
1^72
"RTN","YSPP9")
1^73
"RTN","YSPPJ")
1^74
"RTN","YSPRBR1")
1^75
"RTN","YSPRBR2")
1^76
"RTN","YSPROB")
1^77
"RTN","YSPROB1")
1^78
"RTN","YSPROB2")
1^79
"RTN","YSPROB3")
1^80
"RTN","YSPROB4")
1^81
"RTN","YSPROB5")
1^82
"RTN","YSPROBR")
1^83
"RTN","YSPROBR1")
1^84
"RTN","YSPROSE")
1^85
"RTN","YSPTX")
1^86
"RTN","YSPTX1")
1^87
"RTN","YSPTXR")
1^88
"RTN","YSSITE")
0^222^B3477669
"RTN","YSSITE",1,0)
YSSITE ;SLC/DJP,HIOFO/FT - Entry & Edit of Mental Health System Site Specific Files ;9/15/11 10:28 am
"RTN","YSSITE",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YSSITE",3,0)
 ;
"RTN","YSSITE",4,0)
 ;No external references
"RTN","YSSITE",5,0)
 ;
"RTN","YSSITE",6,0)
ENREA ; Called from MENU option YS SITE-FILE 615.5
"RTN","YSSITE",7,0)
 ;FILE 615.5 - S/R REASONS
"RTN","YSSITE",8,0)
 N DIC,DIE,DA,DR,DLAYGO,X,Y,YFN
"RTN","YSSITE",9,0)
 S DLAYGO=615.5,DIC="^YSR(615.5,",DIC(0)="AEQLM"
"RTN","YSSITE",10,0)
 D ^DIC Q:Y'>0
"RTN","YSSITE",11,0)
 S (DA,YFN)=+Y,DIE=DIC,DR=.01
"RTN","YSSITE",12,0)
 L +^YSR(615.5,DA):DILOCKTM
"RTN","YSSITE",13,0)
 I '$T D ERRMSG Q
"RTN","YSSITE",14,0)
 D ^DIE
"RTN","YSSITE",15,0)
 L -^YSR(615.5,YFN)
"RTN","YSSITE",16,0)
 Q
"RTN","YSSITE",17,0)
ENCAT ; Called from MENU option YS SITE-FILE 615.6
"RTN","YSSITE",18,0)
 ;FILE 615.6 - S/R CATEGORY
"RTN","YSSITE",19,0)
 N DIC,DIE,DA,DR,DLAYGO,X,Y,YFN
"RTN","YSSITE",20,0)
 S DLAYGO=615.6,DIC="^YSR(615.6,",DIC(0)="AEQLM"
"RTN","YSSITE",21,0)
 D ^DIC Q:Y'>0
"RTN","YSSITE",22,0)
 S (DA,YFN)=+Y,DIE=DIC,DR=.01
"RTN","YSSITE",23,0)
 L +^YSR(615.6,YFN):DILOCKTM
"RTN","YSSITE",24,0)
 I '$T D ERRMSG Q
"RTN","YSSITE",25,0)
 D ^DIE
"RTN","YSSITE",26,0)
 L -^YSR(615.6,YFN)
"RTN","YSSITE",27,0)
 Q
"RTN","YSSITE",28,0)
ENRELC ; Called from MENU option YS SITE-FILE 615.7
"RTN","YSSITE",29,0)
 ;FILE 615.7 - S/R REL CRITERIA
"RTN","YSSITE",30,0)
 N DIC,DIE,DA,DR,DLAYGO,X,Y,YFN
"RTN","YSSITE",31,0)
 S DLAYGO=615.7,DIC="^YSR(615.7,",DIC(0)="AEQML"
"RTN","YSSITE",32,0)
 D ^DIC Q:Y'>0
"RTN","YSSITE",33,0)
 S (YFN,DA)=+Y,DIE=DIC,DR=.01
"RTN","YSSITE",34,0)
 L +^YSR(615.7,YFN):DILOCKTM
"RTN","YSSITE",35,0)
 I '$T D ERRMSG Q
"RTN","YSSITE",36,0)
 D ^DIE
"RTN","YSSITE",37,0)
 L -^YSR(615.7,YFN)
"RTN","YSSITE",38,0)
 Q
"RTN","YSSITE",39,0)
ENALT ; Called from MENU option YS SITE-FILE 615.8
"RTN","YSSITE",40,0)
 ;FILE 615.8 - S/R ALTERNATIVES
"RTN","YSSITE",41,0)
 N DIC,DIE,DA,DR,DLAYGO,X,Y,YFN
"RTN","YSSITE",42,0)
 S DLAYGO=615.8,DIC="^YSR(615.8,",DIC(0)="AEQLM"
"RTN","YSSITE",43,0)
 D ^DIC Q:Y'>0
"RTN","YSSITE",44,0)
 S (DA,YFN)=+Y,DIE=DIC,DR=.01
"RTN","YSSITE",45,0)
 L +^YSR(615.8,YFN):DILOCKTM
"RTN","YSSITE",46,0)
 I '$T D ERRMSG Q
"RTN","YSSITE",47,0)
 D ^DIE
"RTN","YSSITE",48,0)
 L -^YSR(615.8,YFN)
"RTN","YSSITE",49,0)
 Q
"RTN","YSSITE",50,0)
ENCKL ; Called from MENU option YS SITE-FILE 615.9
"RTN","YSSITE",51,0)
 N DIC,DIE,DA,DR,DLAYGO,X,Y,YFN
"RTN","YSSITE",52,0)
 S DLAYGO=615.9,DIC="^YSR(615.9,",DIC(0)="AEQLM"
"RTN","YSSITE",53,0)
 D ^DIC Q:Y'>0
"RTN","YSSITE",54,0)
 S (DA,YFN)=+Y,DIE=DIC,DR=.01
"RTN","YSSITE",55,0)
 L +^YSR(615.9,YFN):DILOCKTM
"RTN","YSSITE",56,0)
 I '$T D ERRMSG Q
"RTN","YSSITE",57,0)
 D ^DIE
"RTN","YSSITE",58,0)
 L -^YSR(615.9,YFN)
"RTN","YSSITE",59,0)
 Q
"RTN","YSSITE",60,0)
ERRMSG ;Write error message
"RTN","YSSITE",61,0)
 D EN^DDIOL("Can't lock entry now, please try again later.","","!")
"RTN","YSSITE",62,0)
 Q
"RTN","YSSR")
0^256^B31889856
"RTN","YSSR",1,0)
YSSR ;SLC/AFE,HIOFO/FT - SECLUSION/RESTRAINT - Lookup & Entry ;10/21/11 9:51am
"RTN","YSSR",2,0)
 ;;5.01;MENTAL HEALTH;**82,60**;Dec 30, 1994;Build 47
"RTN","YSSR",3,0)
 ;
"RTN","YSSR",4,0)
 ;Reference to VADPT APIs supported by DBIA #10061
"RTN","YSSR",5,0)
 ;Reference to XUSCLEAN APIs supported by DBIA #10052
"RTN","YSSR",6,0)
 ;Reference to ^DPT( supported by DBIA #10035
"RTN","YSSR",7,0)
 ;
"RTN","YSSR",8,0)
ENLST ; Called from MENU option YSSR ENTRY
"RTN","YSSR",9,0)
 ; Entry of basic S/R information
"RTN","YSSR",10,0)
 W @IOF,!?IOM-$L("SECLUSION/RESTRAINT INFORMATION")\2,"SECLUSION/RESTRAINT INFORMATION",! S MSG1="No patients listed in Seclusion/Restraint." D LKUP
"RTN","YSSR",11,0)
ENTER ;
"RTN","YSSR",12,0)
 D ^YSLRP I YSDFN'>0 G END
"RTN","YSSR",13,0)
 I $D(^YS(615.2,"AC",YSDFN)) W !!,"Patient shown in Seclusion/Restraint at this time.",! D WAIT^YSUTL G END
"RTN","YSSR",14,0)
 W ! S DIC="^YS(615.2,",DIC(0)="L",X="""N""",DLAYGO=615.2 D ^DIC G:Y<1 END S FN=+Y
"RTN","YSSR",15,0)
SQ ;
"RTN","YSSR",16,0)
 S %=0 F  Q:$G(%)  W !,"Was patient searched" S %=1 D 
"RTN","YSSR",17,0)
 .D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I '% W !!,"If patient was not searched, a reason should be given for the omission.",!
"RTN","YSSR",18,0)
 I YSTOUT!YSUOUT!(%=-1) D DELETE G END
"RTN","YSSR",19,0)
 N YSTO S YSTO=0 ;TimeOut check: 1=timed out
"RTN","YSSR",20,0)
 I %=1 D  I YSTO D DELETE G END
"RTN","YSSR",21,0)
 . S DA=FN,DIE=DIC,DR=".08///Y"
"RTN","YSSR",22,0)
 . L +^YS(615.2,DA):DILOCKTM I '$T D ERRMSG^YSSITE S YSTO=1 Q
"RTN","YSSR",23,0)
 . D ^DIE L -^YS(615.2,DA)
"RTN","YSSR",24,0)
 I %=2 D  I YSTO D DELETE G END
"RTN","YSSR",25,0)
 . S DA=FN,DIE=DIC,DR=".08///N;.09"
"RTN","YSSR",26,0)
 . L +^YS(615.2,DA):DILOCKTM I '$T D ERRMSG^YSSITE S YSTO=1 Q
"RTN","YSSR",27,0)
 . D ^DIE L -^YS(615.2,DA)
"RTN","YSSR",28,0)
 . S YSTOUT=$D(DTOUT)
"RTN","YSSR",29,0)
 . S:YSTOUT YSTO=1
"RTN","YSSR",30,0)
 D DXLKUP
"RTN","YSSR",31,0)
 W ! S DIE="^YS(615.2,",DA=FN,DR=".02///"_YSDFN_";.03//NOW;.04:.07;25:27;4///^S X=""`""_DUZ;5:6;7//^S X=YSDX;10;15:20;30"
"RTN","YSSR",32,0)
 L +^YS(615.2,DA):DILOCKTM
"RTN","YSSR",33,0)
 I '$T D ERRMSG^YSSITE D DELETE G END
"RTN","YSSR",34,0)
 K Y D ^DIE L -^YS(615.2,DA)
"RTN","YSSR",35,0)
 S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]""
"RTN","YSSR",36,0)
 I YSTOUT!YSUOUT!('$O(^YS(615.2,DA,5,0)))!('$O(^YS(615.2,DA,6,0)))!($G(^YS(615.2,DA,7))']"")!('$O(^(10,0)))!('+$G(^YS(615.2,DA,25))) W !!?13,"INSUFFICIENT INFORMATION" D DELETE G END
"RTN","YSSR",37,0)
REVIEW ;
"RTN","YSSR",38,0)
 S %=0 F  Q:$G(%)  W !!,"Do you need to edit the above information" S %=1 D 
"RTN","YSSR",39,0)
 .D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I '% W !!,"After the information is filed, you may no longer edit it.",!,"You may alter the information now.",!
"RTN","YSSR",40,0)
 I YSTOUT!YSUOUT D DELETE G END
"RTN","YSSR",41,0)
 I %=1 D EDIT
"RTN","YSSR",42,0)
FILE ;
"RTN","YSSR",43,0)
 S %=0 F  Q:$G(%)  W !!,"Save this information" S %=1 D 
"RTN","YSSR",44,0)
 .D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I '% W !!,"NO, will delete this information from the record.",!,"YES, will file it under the patient's name."
"RTN","YSSR",45,0)
 I %=1 W !!?5,"INFORMATION NOTED.",! Q
"RTN","YSSR",46,0)
 D DELETE
"RTN","YSSR",47,0)
END ; Called by routines YSSR1, YSSR2
"RTN","YSSR",48,0)
 N YSDT,YSPDZ,YSTOUT,YSUOUT,XQT,YSDTM,YSLC,YSLCN,YSTM D KILL^XUSCLEAN
"RTN","YSSR",49,0)
 Q
"RTN","YSSR",50,0)
EDIT ;
"RTN","YSSR",51,0)
 N DA,DIE,DR
"RTN","YSSR",52,0)
 S DIE="^YS(615.2,",DA=FN,DR=".03:3;5:25:27;30"
"RTN","YSSR",53,0)
 L +^YS(615.2,DA):DILOCKTM
"RTN","YSSR",54,0)
 I '$T D ERRMSG^YSSITE Q
"RTN","YSSR",55,0)
 D ^DIE L -^YS(615.2,DA)
"RTN","YSSR",56,0)
 Q
"RTN","YSSR",57,0)
DELETE ; Called by routine YSSR2
"RTN","YSSR",58,0)
 N DA,DIK
"RTN","YSSR",59,0)
 S DIK="^YS(615.2,",DA=FN D ^DIK W !!?10,"< ENTRY FOR "_$P(YSNM,",",2)_" "_$P(YSNM,",")_" DELETED >",!
"RTN","YSSR",60,0)
 Q
"RTN","YSSR",61,0)
PTNAME ; Called by routine YSSR1
"RTN","YSSR",62,0)
 ; Patient look-up.
"RTN","YSSR",63,0)
 W ! D ^YSLRP I $G(X)["^" S YSQT=1 Q
"RTN","YSSR",64,0)
 I YSDFN<1 W !!,"Patient Name Required.",! S YSQT=1 Q
"RTN","YSSR",65,0)
 S YSN=$P(YSNM,",",2)_" "_$P(YSNM,",")
"RTN","YSSR",66,0)
 Q
"RTN","YSSR",67,0)
LKUP ; Called as ENTRY action from MENU option YSSR SEC/RES
"RTN","YSSR",68,0)
 ; Called by routine YSSR1
"RTN","YSSR",69,0)
 ; Lists patients in currently in S/R.  May pass YSQT.
"RTN","YSSR",70,0)
 S:'$D(MSG1) MSG1="No patients currently listed in seclusion/restraint." I '$O(^YS(615.2,"AC",0)) W !?IOM-$L(" ** "_MSG1_" ** ")\2," ** "_MSG1_" ** ",!! Q 
"RTN","YSSR",71,0)
 W !!,"The following patient(s) are currently listed as being in Seclusion/Restraint:  ",!
"RTN","YSSR",72,0)
 D HEADER S A=0 F  S A=$O(^YS(615.2,"AC",A)) Q:'A  S A1=0 F  S A1=$O(^YS(615.2,"AC",A,A1)) Q:'A1  D PNAMES
"RTN","YSSR",73,0)
 I $D(YS02) W !!," * Written order required.",!
"RTN","YSSR",74,0)
 I $D(YS04) W:'$D(YS02) !! W " # Record incomplete, please contact IRM.",!
"RTN","YSSR",75,0)
 I '$D(C1) W !?5," ** ",MSG1," ** " K C1 I $D(OPT) S YSQT=1
"RTN","YSSR",76,0)
 S %DT="T",X="N" D ^%DT
"RTN","YSSR",77,0)
 K YS02,YS04
"RTN","YSSR",78,0)
 Q
"RTN","YSSR",79,0)
PNAMES ; Called by routine YSSR1
"RTN","YSSR",80,0)
 K YS01,YS03 S DFN=A D DEM^VADPT,PID^VADPT S B=VADM(1),SSN=VA("BID") S C1=+1
"RTN","YSSR",81,0)
 S Y=$P($G(^YS(615.2,A1,0)),"^",3) D DD^%DT
"RTN","YSSR",82,0)
 D TTIME
"RTN","YSSR",83,0)
 S JRBY=$P($G(^YS(615.2,A1,25)),"^")
"RTN","YSSR",84,0)
 S JRBYN="" I JRBY S JRBYN=$P(^VA(200,JRBY,0),"^",1)
"RTN","YSSR",85,0)
 S Y=$P($G(^YS(615.2,A1,0)),"^",3) D DD^%DT
"RTN","YSSR",86,0)
 I $D(^YS(615.2,"AF",A)) S (YS01,YS02)="*"
"RTN","YSSR",87,0)
 I '$O(^YS(615.2,A1,5,0))!('$O(^YS(615.2,A1,6,0)))!($G(^YS(615.2,A1,7))']"")!('$O(^(10,0)))!('+$G(^YS(615.2,A1,25))) S (YS03,YS04)="#"
"RTN","YSSR",88,0)
 W !?0,$E(B,1,20),?22,SSN W:$D(YS01) ?28,YS01 I $D(YS03) W ?29,YS03
"RTN","YSSR",89,0)
 W ?31,Y,?52,$E(JRBYN,1,18) I $D(JRTT) W ?71,JRTT
"RTN","YSSR",90,0)
 K JRTT
"RTN","YSSR",91,0)
 K VADM,VA,DFN
"RTN","YSSR",92,0)
 Q
"RTN","YSSR",93,0)
DXLKUP ; Checks ^YSD(627.8 DIAGNOSTIC RESULTS for most recent diagnosis.
"RTN","YSSR",94,0)
 S YSDX="UNKNOWN" I '$D(^YSD(627.8,"AF",YSDFN)) Q
"RTN","YSSR",95,0)
 S K=0,K=$O(^YSD(627.8,"AF",YSDFN,K)),L="",L=$O(^YSD(627.8,"AF",YSDFN,K,L)) S M1=$P(L,";"),M2=$P(L,";",2) K K,L
"RTN","YSSR",96,0)
 I M2["ICD" S N1="^"_M2_M1_","_0_")",YSDX=$P(@N1,"^",1)_" "_$E($P(@N1,"^",3),1,60) Q
"RTN","YSSR",97,0)
 I M2["DIC" S N1="^"_M2_M1_","_0_")",N2=$P(@N1,"^",2),N3="^"_M2_M1_","_3_")",N4=$P(@N3,"^",1),YSDX=N2_" "_$E(N4,1,60)
"RTN","YSSR",98,0)
 K M1,M2,N1,N2,N3,N4
"RTN","YSSR",99,0)
 Q
"RTN","YSSR",100,0)
HEADER ; Write header
"RTN","YSSR",101,0)
 W !?31,"DATE & TIME",?72,"TOTAL",!
"RTN","YSSR",102,0)
 W ?0,"PATIENT",?23,"SSN",?31,"INITIATED",?52,"ORDERED BY",?72,"TIME",!
"RTN","YSSR",103,0)
 F I=1:1:IOM W "="
"RTN","YSSR",104,0)
 W !
"RTN","YSSR",105,0)
 Q
"RTN","YSSR",106,0)
TTIME ;calculate total time
"RTN","YSSR",107,0)
 I $D(^YS(615.2,A1,0)),$P(^(0),"^",3)'="" S R1=$P(^YS(615.2,A1,0),"^",3)
"RTN","YSSR",108,0)
 I $D(^YS(615.2,A1,40)),$P(^(40),"^",3)'="" S R2=$P(^YS(615.2,A1,40),"^",3)
"RTN","YSSR",109,0)
 I '$D(^YS(615.2,A1,40)) D NOW^%DTC W ! S R2=%
"RTN","YSSR",110,0)
 I $D(R1),$D(R2) S Y=R2 D DD^%DT S JROSR=$P(Y,"@",2),Y=R1 D DD^%DT S JRISR=$P(Y,"@",2)
"RTN","YSSR",111,0)
 I $D(R1),$D(R2) D
"RTN","YSSR",112,0)
 . S X=R1,X1=R2
"RTN","YSSR",113,0)
 . ;next 2 lines are FileMan MINUTES function code 
"RTN","YSSR",114,0)
 . S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1)
"RTN","YSSR",115,0)
 . D ^%DTC:X S X=X*1440+Y
"RTN","YSSR",116,0)
 . S R3=X,JRH=X\60,R4=JRH*60,JRMIN=R3-R4 S JRH=$S($L(JRH)=1:"  "_JRH,$L(JRH)=2:" "_JRH,1:JRH)
"RTN","YSSR",117,0)
 . S JRH=" "_JRH,JRTT=JRH_":"_JRMIN
"RTN","YSSR",118,0)
 K R1,R2,R3,R4,JROSR,JRISR,JRH,JRMIN,Y,X,%
"RTN","YSSR",119,0)
 Q
"RTN","YSSR1")
0^257^B21510369
"RTN","YSSR1",1,0)
YSSR1 ;SLC/AFE,HIOFO/FT - SECLUSION/RESTRAINT - Observation, Release & Review ;10/21/11 10:54am
"RTN","YSSR1",2,0)
 ;;5.01;MENTAL HEALTH;**82,60**;Dec 30, 1994;Build 47
"RTN","YSSR1",3,0)
 ;
"RTN","YSSR1",4,0)
 ;Reference to ^DPT( supported by DBIA #10035
"RTN","YSSR1",5,0)
 ;
"RTN","YSSR1",6,0)
ENRLS ; Called from MENU option YSSR RELEASE
"RTN","YSSR1",7,0)
 ;
"RTN","YSSR1",8,0)
 ; Release of patient from S/R episode.
"RTN","YSSR1",9,0)
 W @IOF,!?IOM-$L("RELEASE FROM SECLUSION/RESTRAINT")\2,"RELEASE FROM SECLUSION/RESTRAINT",! S OPT=1,MSG1="No patients listed as requiring release."
"RTN","YSSR1",10,0)
 D LKUP^YSSR I '$D(A1) D END^YSSR Q 
"RTN","YSSR1",11,0)
 D ^YSLRP I YSDFN'>0 D END^YSSR Q
"RTN","YSSR1",12,0)
 S DIC="^YS(615.2,",DIC(0)="X",D="AC",X=YSDFN D IX^DIC S B=+Y I B<1 W $C(7),!!,"Patient not listed as in Seclusion/Restraint." D END^YSSR Q
"RTN","YSSR1",13,0)
 I $D(^YS(615.2,B,40)) S Y=+$P($G(^(40)),U,3) D DD^%DT W !!,$C(7),YSN," shown as released ",Y D END^YSSR Q
"RTN","YSSR1",14,0)
 W ! S DIE="^YS(615.2,",DA=B,DR="40:41;42//NOW"
"RTN","YSSR1",15,0)
 K Y L +^YS(615.2,DA):DILOCKTM
"RTN","YSSR1",16,0)
 I '$T D ERRMSG^YSSITE,END^YSSR Q
"RTN","YSSR1",17,0)
 D ^DIE
"RTN","YSSR1",18,0)
 S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]""
"RTN","YSSR1",19,0)
 I YSTOUT!YSUOUT L -^YS(615.2,DA) K ^YS(615.2,B,40) W !!?10,"< RELEASE DELETED >" D END^YSSR Q
"RTN","YSSR1",20,0)
 S DR="43///^S X=""`""_DUZ;44///NOW;45" D ^DIE
"RTN","YSSR1",21,0)
 L -^YS(615.2,DA) W !!?10,"PATIENT NOTED AS RELEASED."
"RTN","YSSR1",22,0)
 D END^YSSR
"RTN","YSSR1",23,0)
 Q
"RTN","YSSR1",24,0)
ENREV ; Called from MENU option YSSR REVIEW
"RTN","YSSR1",25,0)
 ; Review of S/R action.
"RTN","YSSR1",26,0)
 W @IOF,!?IOM-$L("REVIEW OF SECLUSION/RESTRAINT ASSESSMENT")\2,"REVIEW OF SECLUSION/RESTRAINT ASSESSMENT",!
"RTN","YSSR1",27,0)
REV ;
"RTN","YSSR1",28,0)
 I '$O(^YS(615.2,"AD",0)) W !!,"No review action required." D END^YSSR Q
"RTN","YSSR1",29,0)
 S RVN=0,QRVN=1 W !,"The following S/R actions have not been reviewed: ",! S B=0 F  S B=$O(^YS(615.2,"AD",B)) Q:'B  S B1=0 F  S B1=$O(^YS(615.2,"AD",B,B1)) Q:'B1  S RVN=RVN+1,RVP(RVN)=B1 D REVLST
"RTN","YSSR1",30,0)
ASK ;
"RTN","YSSR1",31,0)
 W !!,"Select action for review: ",QRVN,"// " R A1:DTIME S YSTOUT='$T,YSUOUT=A1["^" Q:YSTOUT!YSUOUT  S:A1="" A1=QRVN I A1'?.N S A1=0
"RTN","YSSR1",32,0)
 I A1<1!(A1>RVN) W !!,$C(7),"Not valid - re-enter." K A1 G ASK
"RTN","YSSR1",33,0)
 W @IOF S (DA,FN)=RVP(A1),DIC="^YS(615.2," D EN^DIQ W !,"**********"
"RTN","YSSR1",34,0)
 S DIE="^YS(615.2,",DA=FN,DR="50;51//A;52//NOW"
"RTN","YSSR1",35,0)
 L +^YS(615.2,DA):DILOCKTM
"RTN","YSSR1",36,0)
 I '$T D ERRMSG^YSSITE,END^YSSR Q
"RTN","YSSR1",37,0)
 D ^DIE
"RTN","YSSR1",38,0)
 S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
"RTN","YSSR1",39,0)
 I YSTOUT!YSUOUT!($O(Y(""))]"") L -^YS(615.2,DA) K ^YS(615.2,FN,50),DA,DIE,DR W !!?10,"< REVIEW ACTION DELETED >" D END^YSSR Q
"RTN","YSSR1",40,0)
 S DR="53///^S X=""`""_DUZ;54///NOW;55"
"RTN","YSSR1",41,0)
 D ^DIE
"RTN","YSSR1",42,0)
 W !!?10,"REVIEW ACTION NOTED." L -^YS(615.2,DA) K DA,DIE,DR
"RTN","YSSR1",43,0)
 I '$D(^YS(615.2,"AD")) W !,"No other review action required." D END^YSSR Q
"RTN","YSSR1",44,0)
 G REV
"RTN","YSSR1",45,0)
 ;
"RTN","YSSR1",46,0)
REVLST ;
"RTN","YSSR1",47,0)
 S RVNM=$P(^DPT(B,0),U),Y=$P(^YS(615.2,B1,0),U,3) D DD^%DT W !?3,RVN,?8,$P(RVNM,",",2)_" "_$P(RVNM,",",1),?40,Y
"RTN","YSSR1",48,0)
 Q
"RTN","YSSR1",49,0)
 ;
"RTN","YSSR1",50,0)
ENCK ; Called from MENU option YSSR 15-CHECK
"RTN","YSSR1",51,0)
 ; Observation of patient in S/R.
"RTN","YSSR1",52,0)
 S YSB=0 D LKUP^YSSR G:'$D(A1) END^YSSR
"RTN","YSSR1",53,0)
 D ^YSLRP I YSDFN'>0 D END^YSSR Q
"RTN","YSSR1",54,0)
 S YSB=$O(^YS(615.2,"AC",YSDFN,YSB)) Q:'YSB  I '$D(^YS(615.2,YSB,60)) S ^YS(615.2,YSB,60,0)="^615.3DA^^"
"RTN","YSSR1",55,0)
 S DIC="^YS(615.2,YSB,60,",DIC(0)="AMELQ",DLAYGO=615.2,DIC("B")="NOW",DA(1)=YSB D ^DIC K DIC("B") I Y<1 D END^YSSR Q
"RTN","YSSR1",56,0)
 S DIE=DIC,DA=+Y,DR="1;4"
"RTN","YSSR1",57,0)
 L +^YS(615.2,YSB):DILOCKTM
"RTN","YSSR1",58,0)
 I '$T D ERRMSG^YSSITE,END^YSSR Q
"RTN","YSSR1",59,0)
 D ^DIE
"RTN","YSSR1",60,0)
 S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
"RTN","YSSR1",61,0)
 I YSTOUT!YSUOUT!('$P($G(^YS(615.2,DA(1),60,DA,0)),U,2))!('$O(^YS(615.2,DA(1),60,DA,60,0))) L -^YS(615.2,YSB) S DIK=DIE D ^DIK W !!?10,"< OBSERVATION DELETED >" D END^YSSR Q
"RTN","YSSR1",62,0)
 S DR="2///^S X=""`""_DUZ;3///NOW"
"RTN","YSSR1",63,0)
 D ^DIE
"RTN","YSSR1",64,0)
 W !!?15,"OBSERVATION NOTED." L -^YS(615.2,YSB)
"RTN","YSSR1",65,0)
 D END^YSSR
"RTN","YSSR1",66,0)
 Q
"RTN","YSSR1",67,0)
ENWO ; Called from MENU option YSSR W-ORDER
"RTN","YSSR1",68,0)
 ; Entry/edit of Type of S/R Order
"RTN","YSSR1",69,0)
 W @IOF,!?IOM-$L("EDIT OF TYPE OF SECLUSION/RESTRAINT ORDER")\2,"EDIT OF TYPE OF SECLUSION/RESTRAINT ORDER",!
"RTN","YSSR1",70,0)
 W !,"SECLUSION/RESTRAINT EPISODES REQUIRING WRITTEN ORDERS:  ",!
"RTN","YSSR1",71,0)
 D HEADER^YSSR S A=0 F  S A=$O(^YS(615.2,"AF",A)) Q:'A  S A1=0 F  S A1=$O(^YS(615.2,"AF",A,A1)) Q:'A1  D PNAMES^YSSR S YSWN=1,YSA1=A1
"RTN","YSSR1",72,0)
 I '$D(YSWN) W !!,"No patients listed as requiring a written order.",! D END^YSSR Q
"RTN","YSSR1",73,0)
 I $D(YS02) W !!," * Written Order Required.",!
"RTN","YSSR1",74,0)
 I $D(YS04) W:'$D(YS02) !! W " # Record incomplete, please contact IRM.",!
"RTN","YSSR1",75,0)
 K YS02,YS04
"RTN","YSSR1",76,0)
 D ^YSLRP I YSDFN'>0 D END^YSSR Q
"RTN","YSSR1",77,0)
WOLKUP ;
"RTN","YSSR1",78,0)
 S YSA1=$O(^YS(615.2,"AF",YSDFN,0)) I 'YSA1 W !!,"Written order not required for this patient.",! D END^YSSR Q
"RTN","YSSR1",79,0)
 S DIE="^YS(615.2,",DA=YSA1,DR="25:27;28///NOW"
"RTN","YSSR1",80,0)
 L +^YS(615.2,YSA1):DILOCKTM
"RTN","YSSR1",81,0)
 I '$T D ERRMSG^YSSITE,END^YSSR Q
"RTN","YSSR1",82,0)
 D ^DIE L -^YS(615.2,YSA1)
"RTN","YSSR1",83,0)
 I $P(^YS(615.2,YSA1,25),U,2)="w" K ^YS(615.2,"AF",YSDFN,YSA1)
"RTN","YSSR1",84,0)
 D END^YSSR
"RTN","YSSR1",85,0)
 Q
"RTN","YSSR2")
0^258^B7632392
"RTN","YSSR2",1,0)
YSSR2 ;SLC/DJP,HIOFO/FT - SECLUSION/RESTRAINT - Management Utilities ;10/21/11 10:21am
"RTN","YSSR2",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YSSR2",3,0)
 ;
"RTN","YSSR2",4,0)
 ;Reference to ^DPT( supported by DBIA #10035
"RTN","YSSR2",5,0)
 ;
"RTN","YSSR2",6,0)
ENEDIT ; Called from MENU option YSSR EDIT
"RTN","YSSR2",7,0)
 ;
"RTN","YSSR2",8,0)
 ; Permits editing of Seclusion/Restraint Entry
"RTN","YSSR2",9,0)
 S DIC="^YS(615.2,",DIC(0)="AEQLM",DLAYGO=615.2,D="C",DIC("A")="Select PATIENT NAME:  " D IX^DIC K DIC("A"),D S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT D END^YSSR Q
"RTN","YSSR2",10,0)
 I Y<0 W !?10,"Patient not shown on file." D END^YSSR Q
"RTN","YSSR2",11,0)
 S DIE=DIC,DA=+Y,DR=".03:3;5:27;30"
"RTN","YSSR2",12,0)
 L +^YS(615.2,DA):DILOCKTM
"RTN","YSSR2",13,0)
 I '$T D ERRMSG^YSSITE,END^YSSR Q
"RTN","YSSR2",14,0)
 D ^DIE
"RTN","YSSR2",15,0)
 L -^YS(615.2,DA)
"RTN","YSSR2",16,0)
 S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
"RTN","YSSR2",17,0)
 I YSTOUT!YSUOUT D END^YSSR Q
"RTN","YSSR2",18,0)
 L +^YS(615.2,DA):DILOCKTM
"RTN","YSSR2",19,0)
 I '$T D ERRMSG^YSSITE,END^YSSR Q
"RTN","YSSR2",20,0)
 I $D(^YS(615.2,DA,40)) S DR="40:42;45" D ^DIE
"RTN","YSSR2",21,0)
 I $D(^YS(615.2,DA,50)) S DR="50:52;55" D ^DIE
"RTN","YSSR2",22,0)
 I $D(^YS(615.2,DA,60)) S DR=60 D ^DIE
"RTN","YSSR2",23,0)
 L -^YS(615.2,DA) D END^YSSR
"RTN","YSSR2",24,0)
 Q
"RTN","YSSR2",25,0)
 ;
"RTN","YSSR2",26,0)
ENTRYD ; Called from MENU option YSSR DELETE
"RTN","YSSR2",27,0)
 ;
"RTN","YSSR2",28,0)
 ; Permit deletion of an entire Seclusion/Restraint Entry.
"RTN","YSSR2",29,0)
 S DIC="^YS(615.2,",DIC(0)="AEQLM",DLAYGO=615.2,D="C",DIC("A")="Select PATIENT NAME:  " D IX^DIC K DIC("A"),D S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT D END^YSSR Q
"RTN","YSSR2",30,0)
 I Y<0 W !?10,"Patient not shown on file." D END^YSSR Q
"RTN","YSSR2",31,0)
 W @IOF S (FN,DA,YSDA)=+Y,DR=".01:60",S=0 D EN^DIQ
"RTN","YSSR2",32,0)
QUES ;
"RTN","YSSR2",33,0)
 W !!,"Is this the entry you wish to delete" S %=2 D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT D END^YSSR Q
"RTN","YSSR2",34,0)
 I %=0 W !!,"YES will remove the entry from the file.  It will not be recoverable.",!,"NO will exit you from this option.  Entry will remain on file.",! G QUES
"RTN","YSSR2",35,0)
 I %=1 S W1=$P(^YS(615.2,DA,0),U,2),W2=^DPT(W1,0),(YSNM,W3)=$P(W2,U),FN=DA D DELETE^YSSR
"RTN","YSSR2",36,0)
 D END^YSSR
"RTN","YSSR2",37,0)
 Q
"RTN","YSSR2",38,0)
 ;
"RTN","YSSR2",39,0)
KILLALL ;This sub routine is an exit action to be called from the following
"RTN","YSSR2",40,0)
 ;'YSSR*' Seclusion/Restraint options.
"RTN","YSSR2",41,0)
 K %DT,A,B,B1,D,D0,DIK,DIQ,DIS,DLAYGO,DTOUT,DUOUT,FN,JRBY,JRBYN,JRVAR
"RTN","YSSR2",42,0)
 K K,L,MSG1,QRVN,RVN,RVNM,RVP,S,SSN,W1,W2,W3,X1,XQY
"RTN","YSSR2",43,0)
 K YS02,YSA1,YSDA,YSDFN,YSDX,YSI,YSN,YSNM,YSWN
"RTN","YSSR2",44,0)
 Q
"RTN","YSSRU")
0^259^B20557028
"RTN","YSSRU",1,0)
YSSRU ;SLC/DJP,HIOFO/FT - Utilities for YS Seclusion/Restraint Reports ;10/20/11 16:14
"RTN","YSSRU",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YSSRU",3,0)
 ;
"RTN","YSSRU",4,0)
 ;No external references
"RTN","YSSRU",5,0)
 ;
"RTN","YSSRU",6,0)
YSMGT ; Called from MENU option YSSR 10-2683
"RTN","YSSRU",7,0)
 ;
"RTN","YSSRU",8,0)
 W @IOF,!!?5,"MONTHLY REPORT OF RESTRAINT AND SECLUSION (VA Form 10-2683)",! D WARN,SETUP I YSTOUT!YSUOUT G KILL
"RTN","YSSRU",9,0)
 S DIC="^YS(615.2,",FLDS="[YSSR 10-2683 PRINT]",BY="[YSSR 10-2683 SORT]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)"
"RTN","YSSRU",10,0)
 G YSDIP
"RTN","YSSRU",11,0)
 ;
"RTN","YSSRU",12,0)
YSREV ; Called from MENU option YSSR REVIEW RPT
"RTN","YSSRU",13,0)
 ;
"RTN","YSSRU",14,0)
 W @IOF,!!?IOM-$L("REVIEW OF SECLUSION/RESTRAINT ACTION REPORT")\2,"REVIEW OF SECLUSION/RESTRAINT ACTION REPORT",! D SETUP I YSTOUT!YSUOUT G KILL
"RTN","YSSRU",15,0)
 S DIC="^YS(615.2,",FLDS="[YSSR REVIEW ACTION PRINT]",BY="[YSSR DATE OF REVIEW]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,50)),U,3) I (YSY'<YSB),(YSY'>YSE)" G YSDIP
"RTN","YSSRU",16,0)
 ;
"RTN","YSSRU",17,0)
YSDATE ; Called from MENU option YSSR MGTRD
"RTN","YSSRU",18,0)
 ;
"RTN","YSSRU",19,0)
 W @IOF,!!?IOM-$L("S/R MANAGEMENT REPORT BY DATE")\2,"S/R MANAGEMENT REPORT BY DATE",! D SETUP I YSTOUT!YSUOUT G KILL
"RTN","YSSRU",20,0)
 S DIC="^YS(615.2,",FLDS="[YSSR DATE MGT PRINT]",BY="[YSSR DATE SORT]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)" G YSDIP
"RTN","YSSRU",21,0)
 ;
"RTN","YSSRU",22,0)
YSWARD ; Called from MENU option YSSR MGTRW
"RTN","YSSRU",23,0)
 ;
"RTN","YSSRU",24,0)
 W @IOF,!!?IOM-$L("S/R MANAGEMENT REPORT BY WARD")\2,"S/R MANAGEMENT REPORT BY WARD",! D SETUP I YSUOUT!YSTOUT G KILL
"RTN","YSSRU",25,0)
 S DIC="^YS(615.2,",FLDS="[YSSR WARD MGT PRINT]",BY="[YSSR WARD MGT SORT]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)" G YSDIP
"RTN","YSSRU",26,0)
 ;
"RTN","YSSRU",27,0)
YSNURSE ; Called from MENU option YSSR MGTRN
"RTN","YSSRU",28,0)
 ;
"RTN","YSSRU",29,0)
 W @IOF,!!?IOM-$L("S/R MANAGEMENT REPORT BY NURSING SHIFT")\2,"S/R MANAGEMENT REPORT BY NURSING SHIFT",! D SETUP I YSUOUT!YSTOUT G KILL
"RTN","YSSRU",30,0)
 S DIC="^YS(615.2,",FLDS="[YSSR NURSE MGT PRINT]",BY="[YSSR NURSE MGT SORT]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)" G YSDIP
"RTN","YSSRU",31,0)
 ;
"RTN","YSSRU",32,0)
YSINQ ; Called from MENU option YSSR MGTRI
"RTN","YSSRU",33,0)
 ;
"RTN","YSSRU",34,0)
 W @IOF,!!?IOM-$L("S/R MANAGEMENT REPORT BY PATIENT EPISODE")\2,"S/R MANAGEMENT REPORT BY PATIENT EPISODE",! D INIT
"RTN","YSSRU",35,0)
 S DIC="^YS(615.2,",DIC(0)="AEQLM",DLAYGO=615.2,D="C",DIC("A")="Select PATIENT NAME:  " D IX^DIC K DIC("A") G:+Y<0 KILL S YSI=$P(^YS(615.2,+Y,0),U)
"RTN","YSSRU",36,0)
 S DIC="^YS(615.2,",FLDS="[YSSR PT INQ PRINT]",BY="@FILE ENTRY DATE",FR=YSI,TO=YSI,DIS(0)="I YSI=$P(^YS(615.2,D0,0),U)" G YSDIP
"RTN","YSSRU",37,0)
YSDIP ;
"RTN","YSSRU",38,0)
 I $D(YSQT) D KILL Q
"RTN","YSSRU",39,0)
 S:'$D(DIOBEG) DIOEND="I YSSRCTR<1 W !!?20,""*** NO REPORT FOUND ***"",!" S L=0 D EN1^DIP
"RTN","YSSRU",40,0)
 W ! D WAIT^YSUTL
"RTN","YSSRU",41,0)
KILL ;
"RTN","YSSRU",42,0)
 K DIOBEG,YSEND,YSM,YSH,YSMIN,YSTIME,YSLCN,YSQT,YSVAR,BY,FLDS,DIC,FR,TO,YSSRCTR,DIOEND,L1,L2,YSDIPA,YSE,YSY,YSB,YSCLN,YSSRCTR
"RTN","YSSRU",43,0)
 Q
"RTN","YSSRU",44,0)
SETUP ;
"RTN","YSSRU",45,0)
 D INIT,BEGDT S YSUOUT=Y'>0 Q:YSTOUT!YSUOUT  S YSB=Y_".000001"
"RTN","YSSRU",46,0)
 D ENDDT S YSUOUT=Y'>0 Q:YSTOUT!YSUOUT  S YSE=Y_".235959"
"RTN","YSSRU",47,0)
 S X=YSB,YSB=$S(YSB>YSE:YSE,1:YSB),YSE=$S(YSE>X:YSE,1:X)
"RTN","YSSRU",48,0)
 S Y=YSE D DD^%DT S YSDIPA("YSEND")=Y S Y=YSB D DD^%DT S YSDIPA("YSBEG")=Y
"RTN","YSSRU",49,0)
 Q
"RTN","YSSRU",50,0)
BEGDT ;
"RTN","YSSRU",51,0)
 W !! S %DT="AE",%DT("A")="BEGINNING DATE: ",%DT(0)="-NOW" D ^%DT K %DT
"RTN","YSSRU",52,0)
 S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)!(Y'>0) Q
"RTN","YSSRU",53,0)
ENDDT ;
"RTN","YSSRU",54,0)
 S %DT="AE",%DT("A")="ENDING DATE: ",%DT("B")="TODAY",%DT(0)="-NOW" D ^%DT K %DT
"RTN","YSSRU",55,0)
 S YSTOUT=$G(DTOUT),YSUOUT=$D(DUOUT)!(Y'>0) Q
"RTN","YSSRU",56,0)
INIT ;
"RTN","YSSRU",57,0)
 S (YSLCN,YSVAR,YSSRCTR)=0
"RTN","YSSRU",58,0)
SITE ;
"RTN","YSSRU",59,0)
 S YSLCN=$$SITE^YSFORM,YSDIPA("YSLCN")="VAMC "_YSLCN Q
"RTN","YSSRU",60,0)
HEADER ;
"RTN","YSSRU",61,0)
 S $P(YSDIPA("HLN"),"=",133)="",YSDIPA("HLN2")=$E(YSDIPA("HLN"),1,80)
"RTN","YSSRU",62,0)
 Q
"RTN","YSSRU",63,0)
PARSE ;Sets variables for use within the print templates used by File ^YS(615.2) - SECLUSION/RESTRAINT
"RTN","YSSRU",64,0)
 K YSDIPA("YSRT"),YSDIPA("YSRT1"),YSDIPA("YSAT1"),YSDIPA("YSTT"),YSDIPA("YSAT") S R1=+$P($G(^YS(615.2,D0,0)),U,3),R2=+$P($G(^(40)),U,3),YSSRCTR=YSSRCTR+1
"RTN","YSSRU",65,0)
 I R1'=0 S YSDIPA("YSAT")=$P(R1,"."),Y=R1 D DD^%DT S YSDIPA("YSAT1")=$P(Y,"@",2)
"RTN","YSSRU",66,0)
 I R2'=0 S YSDIPA("YSRT")=$P(R2,"."),Y=R2 D DD^%DT S YSDIPA("YSRT1")=$P(Y,"@",2)
"RTN","YSSRU",67,0)
 I R2=0 S YSDIPA("YSRT")="*",YSDIPA("YSRT1")=" " K R1,R2 Q
"RTN","YSSRU",68,0)
 S X=R1,X1=R2
"RTN","YSSRU",69,0)
 ;next 2 lines are FileMan MINUTES function code
"RTN","YSSRU",70,0)
 S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1)
"RTN","YSSRU",71,0)
 D ^%DTC:X S X=X*1440+Y
"RTN","YSSRU",72,0)
 S R3=X,YSH=X\60,R4=YSH*60,YSMIN=R3-R4,YSDIPA("YSTT")=YSH_":"_YSMIN
"RTN","YSSRU",73,0)
 K YSVAR,R1,R2,R3,R4,YSH,YSMIN
"RTN","YSSRU",74,0)
 Q
"RTN","YSSRU",75,0)
WARN ;
"RTN","YSSRU",76,0)
 W !!,"WARNING - This report prints out in a 132 column format.",!,"DO NOT SEND TO A TERMINAL."
"RTN","YSSRU",77,0)
 Q
"RTN","YSWX")
1^89
"RTN","YSWX1")
1^90
"RTN","YSWZ")
1^91
"RTN","YSXRAF")
1^292
"RTN","YSXRAF1")
1^293
"RTN","YSXRAF2")
1^294
"RTN","YSXRAF3")
1^295
"RTN","YSXRAF4")
1^296
"RTN","YSXRAF5")
1^297
"RTN","YSXRAF6")
1^298
"RTN","YSXRAG")
1^97
"RTN","YSXRAG1")
1^98
"RTN","YSXRAG2")
1^99
"RTN","YSXRBA")
1^129
"RTN","YSXRBA1")
1^130
"RTN","YSXRBA2")
1^131
"RTN","YSXRBA3")
1^132
"RTN","YSXRBA4")
1^133
"RTN","YSXRBA5")
1^134
"RTN","YSXRBA6")
1^135
"RTN","YTAPI7")
0^242^B16428780
"RTN","YTAPI7",1,0)
YTAPI7 ;ASF/ALB,HIOFO/FT - PSYCH TEST API INCOMPLETES ;9/29/11 15:08
"RTN","YTAPI7",2,0)
 ;;5.01;MENTAL HEALTH;**71,60**;Dec 30, 1994;Build 47
"RTN","YTAPI7",3,0)
 ;
"RTN","YTAPI7",4,0)
 ;Reference to ^XLFDT APIs supported by DBIA #10103
"RTN","YTAPI7",5,0)
 ;
"RTN","YTAPI7",6,0)
SAVEINC(YSDATA,YS) ; save incomplete admins [YTAPI SAVE INCOMPLETES rpc]
"RTN","YTAPI7",7,0)
 N B,R1,R2,R3,DA,DIK,YSNEXT,X,Y,N1,YSADATE,DFN,YSCODE,YSNEXT,YSORDER
"RTN","YTAPI7",8,0)
 D PARSE(.YS)
"RTN","YTAPI7",9,0)
 I '$D(DFN) S YSDATA(1)="[ERROR]",YSDATA(2)="no pt dfn" Q  ;--->OUT
"RTN","YTAPI7",10,0)
 I '$D(YSNEXT) S YSDATA(1)="[ERROR]",YSDATA(2)="no next" Q  ;---> OUT
"RTN","YTAPI7",11,0)
 I YSCODE=""!'$D(^YTT(601,YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad test code" Q  ;--->OUT
"RTN","YTAPI7",12,0)
 I YSORDER'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad ORDERED BY" Q  ;--->OUT
"RTN","YTAPI7",13,0)
SAV1 ;
"RTN","YTAPI7",14,0)
 L +^YTD(601.4,DFN):DILOCKTM
"RTN","YTAPI7",15,0)
 I '$T S YSDATA(1)="[ERROR]",YSDATA(2)="cannot lock record" Q  ;--->OUT
"RTN","YTAPI7",16,0)
 I '$D(^YTD(601.4,DFN,0)) D NEWPT I '$D(^YTD(601.4,DFN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="cannot lock record" Q  ;add at dfn level or OUT
"RTN","YTAPI7",17,0)
 S $P(^YTD(601.4,DFN,1,0),U,2)="601.4P"
"RTN","YTAPI7",18,0)
 S:YSCODE>$P(^YTD(601.4,DFN,1,0),U,3) $P(^YTD(601.4,DFN,1,0),U,3)=YSCODE
"RTN","YTAPI7",19,0)
 S $P(^YTD(601.4,DFN,1,0),U,4)=$P(^YTD(601.4,DFN,1,0),U,4)+1
"RTN","YTAPI7",20,0)
 S ^YTD(601.4,DFN,1,YSCODE,0)=YSCODE_"^"_YSADATE_"^^"_YSNEXT_"^"_$P($G(^YTT(601,YSCODE,"Q",YSNEXT,0)),U,2)_"^^"_YSORDER
"RTN","YTAPI7",21,0)
 S:$P(^YTD(601.4,DFN,1,YSCODE,0),U,8)="" $P(^YTD(601.4,DFN,1,YSCODE,0),U,8)=DT
"RTN","YTAPI7",22,0)
 S B="",N1=YSNEXT+.1 ;bottom text
"RTN","YTAPI7",23,0)
 F  S N1=$O(^YTT(601,YSCODE,"Q",N1),-1) Q:N1'>0  S B=$G(^YTT(601,YSCODE,"Q",N1,"B")) Q:$D(^YTT(601,YSCODE,"Q",N1,"B"))
"RTN","YTAPI7",24,0)
 I $L(B) S ^YTD(601.4,DFN,1,YSCODE,"B")=B
"RTN","YTAPI7",25,0)
 S ^YTD(601.4,DFN,1,YSCODE,1)=R1
"RTN","YTAPI7",26,0)
 S ^YTD(601.4,DFN,1,YSCODE,2)=R2
"RTN","YTAPI7",27,0)
 S ^YTD(601.4,DFN,1,YSCODE,3)=R3
"RTN","YTAPI7",28,0)
 S DIK="^YTD(601.4,",DA=DFN D IX^DIK ;reindex
"RTN","YTAPI7",29,0)
 L -^YTD(601.4,DFN)
"RTN","YTAPI7",30,0)
 S YSDATA(1)="[DATA]",YSDATA(2)="saved ok"
"RTN","YTAPI7",31,0)
 Q
"RTN","YTAPI7",32,0)
NEWPT ;new entry to 601.4
"RTN","YTAPI7",33,0)
 L +^YTD(601.4,0):DILOCKTM Q:'$T
"RTN","YTAPI7",34,0)
 S X=^YTD(601.4,0),X(4)=$P(X,U,4),X(3)=$P(X,U,3),X(4)=X(4)+1
"RTN","YTAPI7",35,0)
 S:DFN>X(3) X(3)=DFN
"RTN","YTAPI7",36,0)
 S X=$P(X,U,1,2)_"^"_X(3)_"^"_X(4)
"RTN","YTAPI7",37,0)
 S ^YTD(601.4,0)=X,^YTD(601.4,DFN,0)=DFN,^YTD(601.4,"B",DFN,DFN)=""
"RTN","YTAPI7",38,0)
 L -^YTD(601.4,0)
"RTN","YTAPI7",39,0)
 Q
"RTN","YTAPI7",40,0)
LISTINC(YSDATA,YS) ;list all incompletes for a pt [YTAPI LIST INCOMPLETES rpc]
"RTN","YTAPI7",41,0)
 N DFN,YSCODE,YSCODEN,X,Y,N,N1,G,YSL,YSADATE,YTLM,YSRSLMT
"RTN","YTAPI7",42,0)
 S YSRSLMT=3
"RTN","YTAPI7",43,0)
 S DFN=$G(YS("DFN"))
"RTN","YTAPI7",44,0)
 I '$D(DFN) S YSDATA(1)="[ERROR]",YSDATA(2)="no pt dfn" Q  ;--->OUT
"RTN","YTAPI7",45,0)
 S YSDATA(1)="[DATA]"
"RTN","YTAPI7",46,0)
 S N1=0 F  S N1=$O(^YTD(601.4,DFN,1,N1)) Q:N1'>0  D
"RTN","YTAPI7",47,0)
 . S G=^YTD(601.4,DFN,1,N1,0)
"RTN","YTAPI7",48,0)
 . S YSCODE=N1,YSCODEN=$P($G(^YTT(601,N1,0)),U)
"RTN","YTAPI7",49,0)
 . S:YSCODEN?1"CLERK".E YSCODE=$P(G,U,6) S:YSCODE>0 YSCODEN=$P(^YTT(601,YSCODE,0),U)
"RTN","YTAPI7",50,0)
 . Q:$P(^YTT(601,YSCODE,0),U,9)'="T"  ;--> OUT  ASF 4/27/01
"RTN","YTAPI7",51,0)
 . S YSL(YSCODEN)=YSCODEN
"RTN","YTAPI7",52,0)
 . S (YSADATE,Y)=$P(G,U,2) D DD^%DT S $P(YSL(YSCODEN),U,2)=Y
"RTN","YTAPI7",53,0)
 . S YTLM=YSRSLMT
"RTN","YTAPI7",54,0)
 . I $P($G(^YTT(601,YSCODE,0)),U,16) S YTLM=$P(^(0),U,16)
"RTN","YTAPI7",55,0)
 . S X=$$FMDIFF^XLFDT(DT,YSADATE,1)
"RTN","YTAPI7",56,0)
 . S $P(YSL(YSCODEN),U,3)=$S(X>YTLM:"not restartable",1:"restartable")
"RTN","YTAPI7",57,0)
 S N1=0,N=0 F  S N1=$O(YSL(N1)) Q:N1=""  D
"RTN","YTAPI7",58,0)
 . S N=N+1
"RTN","YTAPI7",59,0)
 . S YSDATA(N)=YSL(N1)
"RTN","YTAPI7",60,0)
 Q
"RTN","YTAPI7",61,0)
GETINC(YSDATA,YS) ;get saved data [YTAPI GET INCOMPLETES rpc]
"RTN","YTAPI7",62,0)
 N DFN,YSCODE,YSCLERK,YSCLERKN,YSENT
"RTN","YTAPI7",63,0)
 D PARSE(.YS)
"RTN","YTAPI7",64,0)
 I '$D(DFN) S YSDATA(1)="[ERROR]",YSDATA(2)="no pt dfn" Q  ;--->OUT
"RTN","YTAPI7",65,0)
 I YSCODE=""!'$D(^YTT(601,YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad test code" Q  ;--->OUT
"RTN","YTAPI7",66,0)
 I '$D(^YTD(601.4,DFN)) S YSDATA(1)="[ERROR]",YSDATA(2)="no inc for dfn" Q  ;--> OUT
"RTN","YTAPI7",67,0)
 S YSCLERK=$O(^YTT(601,"B","CLERK",0))
"RTN","YTAPI7",68,0)
 S YSCLERKN=$P($G(^YTD(601.4,DFN,1,YSCLERK,0)),U,6)
"RTN","YTAPI7",69,0)
 I '$D(^YTD(601.4,DFN,1,YSCODE))&(YSCODE'=YSCLERKN) S YSDATA(1)="[ERROR]",YSDATA(2)="no data for test" Q  ;-->OUT
"RTN","YTAPI7",70,0)
 S YSENT=$S(YSCODE=YSCLERKN:YSCLERK,1:YSCODE)
"RTN","YTAPI7",71,0)
 S YSDATA(1)="[DATA]"
"RTN","YTAPI7",72,0)
 S YSDATA(2)=^YTD(601.4,DFN,1,YSENT,0)
"RTN","YTAPI7",73,0)
 S YSDATA(3)=$G(^YTD(601.4,DFN,1,YSENT,1))
"RTN","YTAPI7",74,0)
 S YSDATA(4)=$G(^YTD(601.4,DFN,1,YSENT,2))
"RTN","YTAPI7",75,0)
 S YSDATA(5)=$G(^YTD(601.4,DFN,1,YSENT,3))
"RTN","YTAPI7",76,0)
 Q
"RTN","YTAPI7",77,0)
PARSE(YS) ; -- array parsing
"RTN","YTAPI7",78,0)
 S DFN=$G(YS("DFN"))
"RTN","YTAPI7",79,0)
 S YSCODE=$G(YS("CODE"),"ERROR")
"RTN","YTAPI7",80,0)
 S:YSCODE'?1N.N YSCODE=$O(^YTT(601,"B",YSCODE,0))
"RTN","YTAPI7",81,0)
 S YSADATE=$G(YS("ADATE")) S X=YSADATE D ^%DT S YSADATE=Y
"RTN","YTAPI7",82,0)
 S YSORDER=$G(YS("ORDERBY"))
"RTN","YTAPI7",83,0)
 S YSNEXT=$G(YS("NEXT"))
"RTN","YTAPI7",84,0)
 S R1=$G(YS("R1"))
"RTN","YTAPI7",85,0)
 S R2=$G(YS("R2"))
"RTN","YTAPI7",86,0)
 S R3=$G(YS("R3"))
"RTN","YTAPI7",87,0)
 Q
"RTN","YTEX")
1^254
"RTN","YTMCMI2B")
0^220^B14715804
"RTN","YTMCMI2B",1,0)
YTMCMI2B ;ALB/ASF,HIOFO/FT - MCMI2 REPORT CONT ;9/15/11 11:43 am
"RTN","YTMCMI2B",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YTMCMI2B",3,0)
 ;
"RTN","YTMCMI2B",4,0)
 ;No external references
"RTN","YTMCMI2B",5,0)
 ;
"RTN","YTMCMI2B",6,0)
DC ;DISCLOSURE CORRECTION
"RTN","YTMCMI2B",7,0)
 S X=+R I X<145!(X>590)!((X>249)&(X<401)) G HDAA
"RTN","YTMCMI2B",8,0)
 I X>144,X<250 S YSCF=250-X\10 S:250-X/10#1 YSCF=YSCF+1 F I=4:1:25 S YSCF1=$S(I=14:.5,I=15:.5,I=16:.5,I=23:.5,I=24:.5,I=25:.5,1:1),$P(S,U,I)=$P(S,U,I)+(YSCF*YSCF1\1) K YSCF1
"RTN","YTMCMI2B",9,0)
 I X>400,X<591 S YSCF=X-400\16 S:X-400/16#1 YSCF=YSCF+1 F I=4:1:25 S YSCF1=$S(I=14:.5,I=15:.5,I=16:.5,I=23:.5,I=24:.5,I=25:.5,1:1),$P(S,U,I)=$P(S,U,I)-(YSCF1*YSCF\1)
"RTN","YTMCMI2B",10,0)
HDAA ;DEPRESSION/ANXIETY ADJUSTMENT
"RTN","YTMCMI2B",11,0)
 D RD^YTMCMI2A S YSIO=$E(X,176),YSEP=$E(X,177) S:YSIO'="I" YSIO="O" S:YSEP'?1N YSEP=2
"RTN","YTMCMI2B",12,0)
 S YSAS=$P(S,U,17),YSDS=$P(S,U,20),Y=(YSAS-85)+(YSDS-85)
"RTN","YTMCMI2B",13,0)
 I YSEP=2,YSIO="I",YSAS>84,YSDS>84 S Y1=Y*.5\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=Y*.75\1 S:Y1>15 Y1=15 S $P(S,U,15)=$P(S,U,15)-Y1
"RTN","YTMCMI2B",14,0)
 I YSIO="I",YSEP=1,YSAS>84,YSDS>84 S Y1=Y S:Y>25 Y1=25 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S:Y1>20 Y1=20 S $P(S,U,15)=$P(S,U,15)-Y1
"RTN","YTMCMI2B",15,0)
 I YSIO="I",YSEP>2,YSAS>84,YSDS>84 S Y1=Y*.25\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=Y*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
"RTN","YTMCMI2B",16,0)
 I YSIO="O",YSAS>84,YSDS>84 S Y1=((YSAS-85)+(YSDS-85))\4 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=Y*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
"RTN","YTMCMI2B",17,0)
 I YSIO="I",YSEP=2,YSDS>84,YSAS<85 S Y1=YSDS-85*.5\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=YSDS-85*.75\1 S:Y1>15 Y1=15 S $P(S,U,15)=$P(S,U,15)-Y1
"RTN","YTMCMI2B",18,0)
 I YSIO="I",YSEP=1,YSDS>84,YSAS<85 S Y1=YSDS-85 S:Y1>25 Y1=25 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S:Y1>20 Y1=20 S $P(S,U,15)=$P(S,U,15)-Y1
"RTN","YTMCMI2B",19,0)
 I YSIO="I",YSEP>2,YSDS>84,YSAS<85 S Y1=YSDS-85*.25\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=YSDS-85*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
"RTN","YTMCMI2B",20,0)
 I YSIO="O",YSDS>84,YSAS<85 S Y1=YSDS-85*.25\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=YSDS-85*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
"RTN","YTMCMI2B",21,0)
XYZ ;Y-Z CORRECTION
"RTN","YTMCMI2B",22,0)
 S Y1=$P(S,U,2)-$P(S,U,3)/10,Y1=$J(Y1,0,0) S:Y1>10 Y1=10 S:Y1<-10 Y1=-10 F I=14,15,17,18,20 S $P(S,U,I)=$P(S,U,I)+Y1
"RTN","YTMCMI2B",23,0)
DCA ;DENIAL-COMPLAINT ADJUSTMENT
"RTN","YTMCMI2B",24,0)
 K YSS,YSS1,YSS2,^TMP("YT1",$J) F I=4:1:13 S ^TMP("YT1",$J,999-$P(S,U,I),I)=""
"RTN","YTMCMI2B",25,0)
 S Y1=$O(^TMP("YT1",$J,0)),Y2=0 F I=0:1 S Y2=$O(^TMP("YT1",$J,Y1,Y2)) Q:'Y2  S YSS1(Y2)=""
"RTN","YTMCMI2B",26,0)
 I I<2 S Y1=$O(^TMP("YT1",$J,Y1)),Y2=0 F I=0:1 S Y2=$O(^TMP("YT1",$J,Y1,Y2)) Q:'Y2  S YSS2(Y2)=""
"RTN","YTMCMI2B",27,0)
TIES ;
"RTN","YTMCMI2B",28,0)
 S YSS1="",YSS2="" I YSSEX="M" F I=13,4,7,9,10,6,8,11,12,5 S:$D(YSS1(I)) YSS1=YSS1_I_U S:$D(YSS2(I)) YSS2=YSS2_I_U
"RTN","YTMCMI2B",29,0)
 I YSSEX="F" F I=9,4,10,8,5,12,13,11,7,6 S:$D(YSS1(I)) YSS1=YSS1_I_U S:$D(YSS2(I)) YSS2=YSS2_I_U
"RTN","YTMCMI2B",30,0)
 S YSS=YSS1_YSS2
"RTN","YTMCMI2B",31,0)
 I +YSS=7!(+YSS=8)!(+YSS=11)!($P(YSS,U,2)=11) F I=14,15,16,17,20,18 S Y1=$S(I<16:4,I=16:2,I=18:13,1:15) S $P(S,U,I)=$P(S,U,I)+Y1
"RTN","YTMCMI2B",32,0)
 I +YSS=13!(+YSS=5)!($P(YSS,U,2)=5) F I=15,16,14,17,18,20 S Y1=$S(I=14:2,I<17:6,I=17:7,1:5) S $P(S,U,I)=$P(S,U,I)-Y1
"RTN","YTMCMI2B",33,0)
SCP ; LAST CORRECTION
"RTN","YTMCMI2B",34,0)
 I YSIO="I",YSEP=1 F I="23,8","24,10","25,4" S $P(S,U,+I)=$P(S,U,+I)+$P(I,",",2)
"RTN","YTMCMI2B",35,0)
 I YSIO="I",(YSEP=2!(YSEP=0)) F I="23,5","24,7","25,2" S $P(S,U,+I)=$P(S,U,+I)+$P(I,",",2)
"RTN","YTMCMI2B",36,0)
 K Y,Y1,^TMP("YT1",$J) G ^YTMCMI2C
"RTN","YTMCMI2C")
0^221^B21611132
"RTN","YTMCMI2C",1,0)
YTMCMI2C ;ALB/ASF,HIOFO/FT - MCMI2 REPORT CONTINUED ;8/7/12 3:46 am
"RTN","YTMCMI2C",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YTMCMI2C",3,0)
 ;
"RTN","YTMCMI2C",4,0)
 ;No external references
"RTN","YTMCMI2C",5,0)
 ;
"RTN","YTMCMI2C",6,0)
V ;
"RTN","YTMCMI2C",7,0)
 D TOP S V=$P(R,U,26) W !!,"This report is ",$S(V=1:"OF QUESTIONABLE VALIDITY",V>1:"**** INVALID ***",1:"VALID")," based on the validity scale." K V
"RTN","YTMCMI2C",8,0)
 I +R>590!(+R<145) W !,"Validity Questioned based on ",$S(+R>150:"high",1:"low")," DISCLOSURE score"
"RTN","YTMCMI2C",9,0)
 D RD S YSIO=$E(X,176),YSEP=$E(X,177) W:YSIO?1A !,"Patient entered as an ",$S(YSIO="I":"Inpatient",1:"Outpatient"),"." W:YSIO="" !,"No setting entered, patient assumed to be outpatient."
"RTN","YTMCMI2C",10,0)
 W !,"Duration of recent Axis I episode: " W:YSEP'?1N "not entered assumed be one to four weeks"
"RTN","YTMCMI2C",11,0)
 W:YSEP?1N $P("Cannot Categorize^Less than 1 week^1-4 weeks^1-3 months^3-12 months^Periodic; 1-3 years^Continuous; 1-3 years^Periodic; 3-7 years^Continuous 3-7 years^More than 7 years",U,YSEP+1)
"RTN","YTMCMI2C",12,0)
 I $L(X,"X")>12 W !!!,"There were less than 164 responses to the items on the inventory.",!,"Computer interpretative analysis of any responses to these",!,"items would not yield valid results." D:IOST?1"C-".E SCR G DONE
"RTN","YTMCMI2C",13,0)
CD ;
"RTN","YTMCMI2C",14,0)
 W !,"Personality Code= " I +R'>590,+R'<145,$P(R,U,26)<2 D CDX0 F J1="CP","SP" D CDX W "//"
"RTN","YTMCMI2C",15,0)
 W !,"Syndrome Code= " I +R'>590,+R'<145,$P(R,U,26)<2 F J1="CS","SS" D CDX W "//"
"RTN","YTMCMI2C",16,0)
 K ^TMP("YT",$J) W ! D ^YTMCMI2D
"RTN","YTMCMI2C",17,0)
 ;
"RTN","YTMCMI2C",18,0)
 G DONE:YSLFT D SCR G DONE:YSLFT W !!?20,"*** NOTEWORTHY RESPONSES ***",!
"RTN","YTMCMI2C",19,0)
HP D RD W !,"Health Preoccupation" S J2=0 F J1=18,29,33,68,71,72,96 I $E(X,J1)="T" W !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0) S J2=J2+1,J3=1 F  S J3=$O(^YTT(601,201,"Q",J1,"T",J3)) Q:'J3  W !?5,^(J3,0)
"RTN","YTMCMI2C",20,0)
 W:'J2 !?5,"  ** none **"
"RTN","YTMCMI2C",21,0)
IA ;
"RTN","YTMCMI2C",22,0)
 D:$Y+5>IOSL SCR G DONE:YSLFT W !!,"Interpersonal Alienation" S J2=0
"RTN","YTMCMI2C",23,0)
 F J1=13,32,47,49,83,102,141,150 D:$Y+5>IOSL SCR Q:YSLFT  I $E(X,J1)="T" W !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0) S J2=J2+1,J3=1 F  S J3=$O(^YTT(601,201,"Q",J1,"T",J3)) Q:'J3  W !?5,^(J3,0)
"RTN","YTMCMI2C",24,0)
 W:'J2 !?5,"  ** none **"
"RTN","YTMCMI2C",25,0)
ED ;
"RTN","YTMCMI2C",26,0)
 G DONE:YSLFT D:$Y+5>IOSL SCR G DONE:YSLFT W !!,"Emotional Dyscontrol" S J2=0
"RTN","YTMCMI2C",27,0)
 F J1=5,26,36,43,58,67,151,167 D:$Y+5>IOSL SCR Q:YSLFT  I $E(X,J1)="T" W !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0) S J2=J2+1,J3=1 F  S J3=$O(^YTT(601,201,"Q",J1,"T",J3)) Q:'J3  W !?5,^(J3,0)
"RTN","YTMCMI2C",28,0)
 W:'J2 !?5,"  ** none **"
"RTN","YTMCMI2C",29,0)
SDP ;
"RTN","YTMCMI2C",30,0)
 G DONE:YSLFT D:$Y+5>IOSL SCR W !!,"Self-Destructive Potential" S J2=0
"RTN","YTMCMI2C",31,0)
 F J1=54,59,76,79,108,115,120,136 D:$Y+5>IOSL SCR Q:YSLFT  I $E(X,J1)="T" W !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0) S J2=J2+1,J3=1 F  S J3=$O(^YTT(601,201,"Q",J1,"T",J3)) Q:'J3  W !?5,^(J3,0)
"RTN","YTMCMI2C",32,0)
 W:'J2 !?5,"  ** none **"
"RTN","YTMCMI2C",33,0)
 Q
"RTN","YTMCMI2C",34,0)
DONE ;
"RTN","YTMCMI2C",35,0)
 K YSTY,X,Y,A,B,K,YSKK,L,L1,L2,M,J,YSIT,YSRS,YSSS,I,P,YSMX,YSTL,YSTTL Q
"RTN","YTMCMI2C",36,0)
RD ;
"RTN","YTMCMI2C",37,0)
 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
"RTN","YTMCMI2C",38,0)
SCR ;
"RTN","YTMCMI2C",39,0)
 ;  Added 5/6/94 LJA
"RTN","YTMCMI2C",40,0)
 N A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N
"RTN","YTMCMI2C",41,0)
 N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
"RTN","YTMCMI2C",42,0)
 N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
"RTN","YTMCMI2C",43,0)
 ;
"RTN","YTMCMI2C",44,0)
 G:IOST'?1"C-".E TOP F I0=1:1:(IOSL-$Y-2) W !
"RTN","YTMCMI2C",45,0)
 N DTOUT,DUOUT,DIRUT
"RTN","YTMCMI2C",46,0)
 S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
"RTN","YTMCMI2C",47,0)
 D TOP:'YSLFT Q
"RTN","YTMCMI2C",48,0)
CDX0 ;
"RTN","YTMCMI2C",49,0)
 K ^TMP("YT",$J) F J=2:1:25 S A=$P(S,U,J),J1=$S(J<4:"MOD",J<14:"CP",J<17:"SP",J<23:"CS",1:"SS") S J2=$S(A<35:"''",A<60:"""",A<75:"+",A<85:"*",1:"**"),^TMP("YT",$J,J1,J2,999-A,J)=""
"RTN","YTMCMI2C",50,0)
 Q
"RTN","YTMCMI2C",51,0)
CDX ;
"RTN","YTMCMI2C",52,0)
 F J2="**","*","+","""","''" Q:J1'="CP"&(J2="+")  W:'$D(^TMP("YT",$J,J1,J2)) " - " D CDX1 W J2," "
"RTN","YTMCMI2C",53,0)
 Q
"RTN","YTMCMI2C",54,0)
CDX1 ;
"RTN","YTMCMI2C",55,0)
 S J3=0 F  S J3=$O(^TMP("YT",$J,J1,J2,J3)) Q:'J3  D CDX2:J1'="CP",CDXM:J1="CP"&(YSSEX="M"),CDXF:J1="CP"&(YSSEX="F")
"RTN","YTMCMI2C",56,0)
 Q
"RTN","YTMCMI2C",57,0)
CDX2 S J4=0 F  S J4=$O(^TMP("YT",$J,J1,J2,J3,J4)) Q:'J4  W $P($P(^YTT(601,201,"S",J4,0),U,2)," ")," "
"RTN","YTMCMI2C",58,0)
 Q
"RTN","YTMCMI2C",59,0)
CDXM ;
"RTN","YTMCMI2C",60,0)
 F J4=13,4,7,9,10,6,8,11,12,5 I $D(^TMP("YT",$J,J1,J2,J3,J4)) W $P($P(^YTT(601,201,"S",J4,0),U,2)," ")," "
"RTN","YTMCMI2C",61,0)
 Q
"RTN","YTMCMI2C",62,0)
CDXF ;
"RTN","YTMCMI2C",63,0)
 F J4=9,4,10,8,5,12,13,11,7,6 I $D(^TMP("YT",$J,J1,J2,J3,J4)) W $P($P(^YTT(601,201,"S",J4,0),U,2)," ")," "
"RTN","YTMCMI2C",64,0)
 Q
"RTN","YTMCMI2C",65,0)
TOP ;
"RTN","YTMCMI2C",66,0)
 S X=$P(^YTT(601,YSTEST,"P"),U) D DTA^YTREPT W !!?(72-$L(X)\2),X Q
"RTN","YTMMPI2")
0^240^B20251423
"RTN","YTMMPI2",1,0)
YTMMPI2 ;ALB/ASF,HIOFO/FT - MMPI2 REPORT ;9/15/11  13:14
"RTN","YTMMPI2",2,0)
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
"RTN","YTMMPI2",3,0)
 ;
"RTN","YTMMPI2",4,0)
 ;Reference to TERMINAL TYPE (#3.2) file supported by DBIA #5725) - pending
"RTN","YTMMPI2",5,0)
 ;
"RTN","YTMMPI2",6,0)
 S J=1,(YSTR,YSFR,YSQR)=0 F I=1:1:3 I $D(^YTD(601.2,YSDFN,1,YSET,1,YSED,I)) S X=^(I),L=$L(X) F K=1:1:L S:$E(X,K)="X" YSQR=YSQR+1 S:$E(X,K)="T" YSTR=YSTR+1 S:$E(X,K)="F" YSFR=YSFR+1
"RTN","YTMMPI2",7,0)
T0 ;
"RTN","YTMMPI2",8,0)
 S L=200,M=0,YSKK=1,YSTL=0 D RD
"RTN","YTMMPI2",9,0)
T01X ;
"RTN","YTMMPI2",10,0)
 I '$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) S A(J)=YSTL,J=J+1 G T0:J<14,RD1
"RTN","YTMMPI2",11,0)
 S Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0),P=1
"RTN","YTMMPI2",12,0)
T03X ;
"RTN","YTMMPI2",13,0)
 S YSIT=$P(Y,U,P) I YSIT="" S YSKK=YSKK+1 G T01X
"RTN","YTMMPI2",14,0)
 S B=$P(Y,U,P+1),P=P+2
"RTN","YTMMPI2",15,0)
T3 ;
"RTN","YTMMPI2",16,0)
 I YSIT>L S L=L+200,M=M+200 D RD G T3
"RTN","YTMMPI2",17,0)
 S:$E(X,YSIT-M)=B YSTL=YSTL+1 G T03X
"RTN","YTMMPI2",18,0)
RD ;
"RTN","YTMMPI2",19,0)
 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
"RTN","YTMMPI2",20,0)
RD1 ;
"RTN","YTMMPI2",21,0)
MF ;SCALE 5 FIX
"RTN","YTMMPI2",22,0)
 S YSND=$S(YSSX="F":"FK",1:"MK"),Y=^YTT(601,YSTEST,"S",8,YSND)
"RTN","YTMMPI2",23,0)
 F P=1,3,5,7 S YSIT=$P(Y,U,P),B=$P(Y,U,P+1) S X=$S(YSIT>200:$E(^YTD(601.2,YSDFN,1,YSET,1,YSED,2),YSIT-200),1:$E(^YTD(601.2,YSDFN,1,YSET,1,YSED,1),YSIT)) S:X=B A(8)=A(8)+1
"RTN","YTMMPI2",24,0)
 S R="" F I=1:1:13 S R=R_A(I)_U
"RTN","YTMMPI2",25,0)
 K A S YSRNK=R
"RTN","YTMMPI2",26,0)
K ;CORRECTION SCALE MODIFIER
"RTN","YTMMPI2",27,0)
 S X=$P(R,U,3) S $P(R,U,4)=$P(R,U,4)+$J(X*.5,0,0) S $P(R,U,7)=$P(R,U,7)+$J(X*.4,0,0) S $P(R,U,10)=$P(R,U,10)+X S $P(R,U,11)=$P(R,U,11)+X S $P(R,U,12)=$P(R,U,12)+$J(X*.2,0,0)
"RTN","YTMMPI2",28,0)
ST ;
"RTN","YTMMPI2",29,0)
 S S="",J=1,P=YSSX
"RTN","YTMMPI2",30,0)
LK ;
"RTN","YTMMPI2",31,0)
 S A=$P(R,U,J) G:A="" K0 S L1=$P(^YTT(601,YSTEST,"S",J,P),U) I A<L1 S YSTVL=$P(^(P),U,2) G LK1
"RTN","YTMMPI2",32,0)
 S YSTVL=$P(^YTT(601,YSTEST,"S",J,P),U,A+2-L1) I YSTVL="" S YSTVL=$P(^(P),U,$L(^(P),"^"))
"RTN","YTMMPI2",33,0)
LK1 ;
"RTN","YTMMPI2",34,0)
 S S=S_YSTVL_"^",J=J+1 G LK
"RTN","YTMMPI2",35,0)
K0 ;
"RTN","YTMMPI2",36,0)
 K YSTVL S (YSSCALEB,YSSCALE)=S,YSRAW=R
"RTN","YTMMPI2",37,0)
HD ;
"RTN","YTMMPI2",38,0)
 S DOT=YSHD,YSNS=13,V(3)="",YSSK="B",YSSNM="L ,F ,K ,HS,D ,HY,PD,MF,PA,PT,SC,MA,SI"
"RTN","YTMMPI2",39,0)
 S X="   M M P I 2   P R O F I L E      ",Y=70-$L(X)\2 W @IOF,!!?Y,X,$P(^YTT(601,YSTEST,0),U) D ^YTMMPI2P G:YSLFT END
"RTN","YTMMPI2",40,0)
BOTTM ;
"RTN","YTMMPI2",41,0)
 W !?YSLM+6 F I=1:1:YSNS W $E($P(YSSNM,",",I)_"    ",1,4)
"RTN","YTMMPI2",42,0)
 W !?2,"Raw Score:" F I=1:1:YSNS W $J($P(YSRNK,U,I),4) W:I=3 " "
"RTN","YTMMPI2",43,0)
 S X=$P(R,U,3) W !!?2,"K Corr.",?27,$J(X*.5,2,0),?$X+10,$J(X*.4,2,0),?$X+10,$J(X,2),"  ",$J(X,2),"  ",$J(X*.2,2,0)
"RTN","YTMMPI2",44,0)
 W !!?2,"T Score:  " F I=1:1:YSNS W $J($P(S,U,I),4) W:I=3 " "
"RTN","YTMMPI2",45,0)
 W !!?2,"? Cannot Say (Raw): ",YSQR,?35,"F-K (Raw): ",$P(R,U,2)-$P(R,U,3)
"RTN","YTMMPI2",46,0)
 W !?2,"Percent True:",$J(YSTR/$P(^YTT(601,YSTEST,0),U,11)*100,3,0),?$X+7,"Percent False:",$J(YSFR/$P(^YTT(601,YSTEST,0),U,11)*100,3,0),?$X+7,"Profile Elev.:"
"RTN","YTMMPI2",47,0)
 S X=0 F I=4,5,6,7,9,10,11,12 S X=X+$P(S,U,I)
"RTN","YTMMPI2",48,0)
 W $J(X/8,5,1)
"RTN","YTMMPI2",49,0)
WC ;WELSH CODE
"RTN","YTMMPI2",50,0)
 S YSULON="",YSULOF="",Z=2
"RTN","YTMMPI2",51,0)
 ;I IO=0 S YSULON="*27,*91,*52,*109",YSULOF=HL ; *** PC *** 
"RTN","YTMMPI2",52,0)
 ;I IO>0 S YSULON="*27,*45,1",YSULOF="*27,*45,0"
"RTN","YTMMPI2",53,0)
 ;I $D(^%ZIS(2,IO,6)) S YSULON=$P(^%ZIS(2,IO,6),U,4),YSULOF=$P(^(6),U,5)
"RTN","YTMMPI2",54,0)
 S YSULON=$$GET1^DIQ(3.2,IO_",",23)
"RTN","YTMMPI2",55,0)
 S YSULOF=$$GET1^DIQ(3.2,IO_",",24)
"RTN","YTMMPI2",56,0)
 K ^TMP($J,"YTMMPI2") F I=4:1:13 S X=999-$P(S,U,I),X1=$S(I=13:0,1:I-3) S:'$D(^TMP($J,"YTMMPI2",X)) ^(X)="" S ^(X)=^(X)_X1
"RTN","YTMMPI2",57,0)
 W !!?2,"Welsh Code (new): " S X=0,Z=2
"RTN","YTMMPI2",58,0)
 F  S X=$O(^TMP($J,"YTMMPI2",X)) Q:'X  S X1=^(X),X2=999-X,Y=X,Y=$O(^TMP($J,"YTMMPI2",Y)) S:Y Y=999-Y D UL:$L(X1)>1!(X2-Y<2) W X1 S Z1=Z D:(X2-Y>1) ULOF:Z1=1,NUL:Z1'=1 D WCM
"RTN","YTMMPI2",59,0)
 K ^TMP($J,"YTMMPI2") F I=1,2,3 S X=999-$P(S,U,I),X1=$S(I=1:"L",I=2:"F",1:"K") S:'$D(^TMP($J,"YTMMPI2",X)) ^(X)="" S ^(X)=^(X)_X1
"RTN","YTMMPI2",60,0)
 W "   " S X=0,Z=2
"RTN","YTMMPI2",61,0)
 F  S X=$O(^TMP($J,"YTMMPI2",X)) Q:'X  S X1=^(X),X2=999-X,Y=X,Y=$O(^TMP($J,"YTMMPI2",Y)) S:Y Y=999-Y D UL:$L(X1)>1!(X2-Y<2) W X1 S Z1=Z D:(X2-Y>1) ULOF:Z1=1,NUL:Z1'=1 D WCM
"RTN","YTMMPI2",62,0)
 W:YSULON="" "   unable to show ties"
"RTN","YTMMPI2",63,0)
 W !! D DTA^YTMMPI2P,WAIT^YTMMPI2P G:YSLFT END
"RTN","YTMMPI2",64,0)
OUT ;
"RTN","YTMMPI2",65,0)
 K X1,X2,X3,DIC D:^YTT(601,YSTEST,0)?1"MMPI2".E SUP^YTMMPI2A
"RTN","YTMMPI2",66,0)
END ;
"RTN","YTMMPI2",67,0)
 K A,B,C,G,H,I,J,K,L,L1,M,N,P,R,S,V,X,X1,X2,X3,Y,YSAST,YSB1,YSB2,YSBV,YSCNT,YSF,YSFR,YSHS,YSINC,YSIN2,YSIT,YSIT1,YSIT2,YSKK,YSKY,YSLE,YSLL,YSLM,YSLV,YSN,YSND,YSNS,YSOFF,YSQR,YSRAW,YSRNK,YSSCALE,YSSCALEB
"RTN","YTMMPI2",68,0)
 K YSSK,YSSNM,YSSNM1,YSTL,YSTR,YSTV,YSTVL,YSULON,YSULOF,YSVS Q
"RTN","YTMMPI2",69,0)
UL ;
"RTN","YTMMPI2",70,0)
 W:Z=0 " " W:$L(YSULON) @YSULON S Z=1 Q
"RTN","YTMMPI2",71,0)
ULOF ;
"RTN","YTMMPI2",72,0)
 W:$L(YSULOF) @YSULOF S Z=0 Q
"RTN","YTMMPI2",73,0)
NUL ;
"RTN","YTMMPI2",74,0)
 S Z=2 Q
"RTN","YTMMPI2",75,0)
WCM ;
"RTN","YTMMPI2",76,0)
 S N=0 F K=100:-10:30 S N=N+1 I (X2>(K-1))&(Y<K) W $P("**^*^""^'^-^/^:^#",U,N) S:Z=0 Z=2 Q:Y<1
"RTN","YTONLY")
0^243^B29076478
"RTN","YTONLY",1,0)
YTONLY ;ASF/ALB,HIOFO/FT - Restricted Psych Testing Option ;8/7/12 3:41pm
"RTN","YTONLY",2,0)
 ;;5.01;MENTAL HEALTH;**19,37,60**;Dec 30, 1994;Build 47
"RTN","YTONLY",3,0)
 ;
"RTN","YTONLY",4,0)
 ;Reference to VADPT APIs supported by DBIA #10061
"RTN","YTONLY",5,0)
 ;Reference to ^%ZIS supported by IA #10086
"RTN","YTONLY",6,0)
 ;Reference to ^XLFDT APIs supported by DBIA #10103
"RTN","YTONLY",7,0)
 ;Reference to ^VA(200 supported by IA #10060
"RTN","YTONLY",8,0)
 ;Reference to ^XLFSTR supported by DBIA #10104
"RTN","YTONLY",9,0)
 ;
"RTN","YTONLY",10,0)
MAIN ; main loop
"RTN","YTONLY",11,0)
 S (YSXT,YSENTRY)=$O(^YTT(601,"B",YSCODE,0))
"RTN","YTONLY",12,0)
 S YSXTP=1,T1=1,T1(0)=$P(^YTT(601,YSXT,"P"),U,4)
"RTN","YTONLY",13,0)
 S YSPREV=0
"RTN","YTONLY",14,0)
 I YSENTRY=""!($P(^YTT(601,YSENTRY,0),U,13)="N") W !,"Instrument "_YSCODE_" not available" H 3 Q
"RTN","YTONLY",15,0)
 S YSTITLE=$P($G(^YTT(601,YSENTRY,"P")),U)
"RTN","YTONLY",16,0)
 W @IOF,!,$$CJ^XLFSTR(YSTITLE,79," "),!
"RTN","YTONLY",17,0)
 D PT G END:$G(YSDFN)<1
"RTN","YTONLY",18,0)
 D NX,PREV
"RTN","YTONLY",19,0)
 D OPT1 Q:$D(DIRUT)
"RTN","YTONLY",20,0)
 D ADMIN:YSOPT="A",PRINT:YSOPT="P",CLERK:YSOPT="C"
"RTN","YTONLY",21,0)
 ;
"RTN","YTONLY",22,0)
 G MAIN
"RTN","YTONLY",23,0)
ADMIN ;
"RTN","YTONLY",24,0)
 K J
"RTN","YTONLY",25,0)
 I $D(^YTD(601.4,YSDFN,1,YSENTRY)) G RESTART
"RTN","YTONLY",26,0)
 S YSOK=1 W !! S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Professional requesting instrument: ",DIC("B")=DUZ D ^DIC K DIC I Y<1 S YSOK=-1 Q
"RTN","YTONLY",27,0)
 S YSORD=+Y
"RTN","YTONLY",28,0)
 S YSQ=0 D A31^YTCLERK1 I YSOK<1 D KAR^YTS Q
"RTN","YTONLY",29,0)
 I YSQ S ZTIO=ION D HOME^%ZIS
"RTN","YTONLY",30,0)
 S YSTEST=YSENTRY,YSXT=YSENTRY,YSXTP=1
"RTN","YTONLY",31,0)
 D A4^YTAR
"RTN","YTONLY",32,0)
 Q
"RTN","YTONLY",33,0)
RESTART ;
"RTN","YTONLY",34,0)
 K DIR S DIR(0)="S^R:Restart "_YSCODE_";D:Delete previous incomplete and administer;Q:Quit"
"RTN","YTONLY",35,0)
 D ^DIR K DIR
"RTN","YTONLY",36,0)
 Q:$D(DIRUT)!(Y="Q")
"RTN","YTONLY",37,0)
 I Y="D" S YSTEST=YSENTRY D KT,ADMIN Q
"RTN","YTONLY",38,0)
 S YSTEST=YSENTRY
"RTN","YTONLY",39,0)
 S YTLM=3
"RTN","YTONLY",40,0)
 I $P($G(^YTT(601,YSTEST,0)),U,16) S YTLM=$P(^(0),U,16)
"RTN","YTONLY",41,0)
 S X2=$S($P(^YTD(601.4,YSDFN,1,YSTEST,0),U,8):$P(^(0),U,8),1:$P(^(0),U,2))
"RTN","YTONLY",42,0)
 S X=$$FMDIFF^XLFDT(DT,X2,1)
"RTN","YTONLY",43,0)
 I X>YTLM W !,"Administration discontinued more than "_YTLM_" days ago -- not restartable" H 2 Q
"RTN","YTONLY",44,0)
 S YSTEST=YSENTRY
"RTN","YTONLY",45,0)
 S (B,C)="",J=+$P(^YTD(601.4,YSDFN,1,YSENTRY,0),U,4),C=$P(^(0),U,5),YSORD=$P(^(0),U,7) S:$P(^(0),U,8) YSBEGIN=$P(^(0),U,8)
"RTN","YTONLY",46,0)
 I $D(^YTD(601.4,YSDFN,1,YSENTRY,"B"))#2 S B=^("B")
"RTN","YTONLY",47,0)
 S YSRP=$S(J#200=1:"",1:^YTD(601.4,YSDFN,1,YSENTRY,J+198\200)) S:'J J=1
"RTN","YTONLY",48,0)
 S YSXT=YSTEST_"^" S:$D(^YTD(601.4,YSDFN,1,YSENTRY,"R")) YSXT=YSXT_^("R") S YSXTP=1,YSDEMO="N",YSRESTRT=1
"RTN","YTONLY",49,0)
 S YSQ=0 D A31^YTCLERK1 I YSOK<1 D KAR^YTS Q
"RTN","YTONLY",50,0)
 I YSQ S ZTIO=ION D HOME^%ZIS
"RTN","YTONLY",51,0)
 D A4^YTAR
"RTN","YTONLY",52,0)
 Q
"RTN","YTONLY",53,0)
PRINT ;
"RTN","YTONLY",54,0)
 S YSXT=""
"RTN","YTONLY",55,0)
 W !
"RTN","YTONLY",56,0)
 D DU^YTDP
"RTN","YTONLY",57,0)
 Q
"RTN","YTONLY",58,0)
CLERK ;
"RTN","YTONLY",59,0)
 S YSCL=1,(YTESTN,YSTESTN)=YSCODE,YSCLERK=14,YSENT=14,YSTEST=YSENTRY,YSNQ=$P(^YTT(601,YSENTRY,0),U,11)
"RTN","YTONLY",60,0)
 I $D(^YTD(601.4,YSDFN,1,"AC",YSENTRY)) W !!,"Discontinued CLERK test found:" G RESTART^YTCLERK1
"RTN","YTONLY",61,0)
 I $D(^YTD(601.4,YSDFN)) S DIK="^YTD(601.4,",DA=YSDFN D ^DIK K DIK
"RTN","YTONLY",62,0)
 S YSOK=1 W !! S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Professional requesting instrument: ",DIC("B")=DUZ D ^DIC K DIC I Y<1 S YSOK=-1 Q
"RTN","YTONLY",63,0)
 S YSORD=+Y
"RTN","YTONLY",64,0)
 S YSQ=0 D A31^YTCLERK1 I YSOK<1 D KAR^YTS Q
"RTN","YTONLY",65,0)
 S (J,YSXTP)=1,(B,C,YSRP)=""
"RTN","YTONLY",66,0)
 D REY1^YTCLERK
"RTN","YTONLY",67,0)
 Q
"RTN","YTONLY",68,0)
PT ;
"RTN","YTONLY",69,0)
 D ^YSLRP G:YSDFN<1 END D ENPT^YSUTL
"RTN","YTONLY",70,0)
 I YSSEX="" W !,"Gender not properly specified. Call IRM" H 3 G MAIN
"RTN","YTONLY",71,0)
 Q
"RTN","YTONLY",72,0)
OPT1 ;admin, clerk, print
"RTN","YTONLY",73,0)
 W !
"RTN","YTONLY",74,0)
 K DIR
"RTN","YTONLY",75,0)
 S DIR(0)="S^A:Administer on-line;C:Clerk entry"
"RTN","YTONLY",76,0)
 S:YSPREV DIR(0)=DIR(0)_";P:Print"
"RTN","YTONLY",77,0)
 S DIR("A")=$S(YSPREV:"Administer on-line, Clerk entry or Print",1:"Administer on-line or Clerk entry")
"RTN","YTONLY",78,0)
 D ^DIR
"RTN","YTONLY",79,0)
 S YSOPT=Y
"RTN","YTONLY",80,0)
 K DIR
"RTN","YTONLY",81,0)
 G MAIN:$D(DIRUT)
"RTN","YTONLY",82,0)
 Q
"RTN","YTONLY",83,0)
NX ;
"RTN","YTONLY",84,0)
 K A,A1
"RTN","YTONLY",85,0)
 S %=$H>21549+$H-.1,%Y=%\365.25+141,%=%#365.25\1,YSPTD=%+306#(%Y#4=0+365)#153#61#31+1,YSPTM=%-YSPTD\29+1,Y=%Y_"00"+YSPTM_"00"+YSPTD,YSDT(0)=$$FMTE^XLFDT(Y,"5ZD")
"RTN","YTONLY",86,0)
 S YSSX=YSSEX,YSBL="           ",YSHDR=YSSSN_"  "_YSNM_YSBL_YSBL_YSBL,YSHDR=$E(YSHDR,1,44)_YSSX_" AGE "_YSAGE,YSHD=DT
"RTN","YTONLY",87,0)
 S YSHDT=""
"RTN","YTONLY",88,0)
 I '$D(^YTD(601.2,YSDFN,1,YSENTRY)) K A,A1 Q
"RTN","YTONLY",89,0)
 S YSNT=0,N2=0 F  S N2=$O(^YTD(601.2,YSDFN,1,YSENTRY,1,N2)) Q:'N2  S A(YSCODE,N2)=YSENTRY,YSNT=YSNT+1,A1(YSNT)=YSCODE_U_N2_U_YSENTRY
"RTN","YTONLY",90,0)
 Q
"RTN","YTONLY",91,0)
PREV ;
"RTN","YTONLY",92,0)
 W @IOF,YSHDR
"RTN","YTONLY",93,0)
 I '$D(A1(1)),'$D(^YTD(601.4,YSDFN,1,YSENTRY,0)),'$D(^YTD(601.4,YSDFN,1,"AC",YSENTRY)) W !!,?10,"No Previous Administrations on File" S YSPREV=0 Q
"RTN","YTONLY",94,0)
 I $D(^YTD(601.4,YSDFN,1,YSENTRY,0)) W !!,"Incomplete "_YSCODE_" on-line administration found on " S Y=$P(^(0),U,2) X ^DD("DD") W Y Q
"RTN","YTONLY",95,0)
 I $D(^YTD(601.4,YSDFN,1,"AC",YSENTRY)) W !!,"Incomplete "_YSCODE_" clerk entry found on " S Y=$P(^YTD(601.4,YSDFN,1,14,0),U,2) X ^DD("DD") W Y Q
"RTN","YTONLY",96,0)
 ;
"RTN","YTONLY",97,0)
 W !!,"Previous Administrations of the",$S(YSTITLE["*":$TR(YSTITLE,"*",""),YSTITLE["-":$TR(YSTITLE,"-",""),1:" "_YSTITLE),!!
"RTN","YTONLY",98,0)
 F I=1:1 Q:'$D(A1(I))  D
"RTN","YTONLY",99,0)
 . S YSPREV=I
"RTN","YTONLY",100,0)
 . S Y=$P(A1(I),U,2)
"RTN","YTONLY",101,0)
 . X ^DD("DD")
"RTN","YTONLY",102,0)
 . W:$X>60 !
"RTN","YTONLY",103,0)
 . W $J(I,3)_" "_Y_"   "
"RTN","YTONLY",104,0)
 Q
"RTN","YTONLY",105,0)
KT ;
"RTN","YTONLY",106,0)
 K J I $D(^YTD(601.4,YSDFN,1,YSTEST)) S YSENTRY=YSTEST D ENKIL^YTFILE
"RTN","YTONLY",107,0)
 Q
"RTN","YTONLY",108,0)
END ;
"RTN","YTONLY",109,0)
 D KVAR^VADPT
"RTN","YTONLY",110,0)
 K %,%Y,A,A1,B,C,I,J,N2,T1,X,X2,Y,YSAGE,YSBEGIN,YSBL,YSCL,YSCLERK
"RTN","YTONLY",111,0)
 K YSCODE,YSDEMO,YSDFN,YSDT,YSENT,YSENTRY,YSHD,YSHDR,YSHDT,YSNM,YSNQ
"RTN","YTONLY",112,0)
 K YSNT,YSOK,YSOPT,YSORD,YSPREV,YSPTD,YSPTM,YSQ,YSRESTRT,YSRP,YSSEX
"RTN","YTONLY",113,0)
 K YSSSN,YSSX,YSTEST,YSTESTN,YSTITLE,YSXT,YSXTP,YTESTN,YTLM
"RTN","YTONLY",114,0)
 Q
"RTN","YTQQI001")
1^136
"RTN","YTQQI002")
1^137
"RTN","YTQQI003")
1^138
"RTN","YTQQI004")
1^139
"RTN","YTQQI005")
1^140
"RTN","YTQQI006")
1^141
"RTN","YTQQI007")
1^142
"RTN","YTQQI008")
1^143
"RTN","YTQQI009")
1^144
"RTN","YTQQI00A")
1^145
"RTN","YTQQI00B")
1^146
"RTN","YTQQI00C")
1^147
"RTN","YTQQI00D")
1^148
"RTN","YTQQI00E")
1^149
"RTN","YTQQI00F")
1^150
"RTN","YTQQI00G")
1^151
"RTN","YTQQI00H")
1^152
"RTN","YTQQI00I")
1^153
"RTN","YTQQI00J")
1^154
"RTN","YTQQI00K")
1^155
"RTN","YTRPWRP")
0^291^B16819326
"RTN","YTRPWRP",1,0)
YTRPWRP ;DALOI/YH - Report Calls ;8/2/10 2:44pm
"RTN","YTRPWRP",2,0)
 ;;5.01;MENTAL HEALTH;**71,76,96,60**;Dec 30, 1994;Build 47
"RTN","YTRPWRP",3,0)
 ;
"RTN","YTRPWRP",4,0)
 ;Reference to VADPT APIs supported by DBIA #10061
"RTN","YTRPWRP",5,0)
 ;Reference to ^XLFDT APIs supported by DBIA #10103
"RTN","YTRPWRP",6,0)
 ;Reference to ^%ZISC supported by IA #10089
"RTN","YTRPWRP",7,0)
 ;Reference to ^%ZIS supported by IA #10086
"RTN","YTRPWRP",8,0)
 ;Reference to %ZISH supported by DBIA #2320
"RTN","YTRPWRP",9,0)
 ;Reference to DT^DICRW supported by DBIA #10005
"RTN","YTRPWRP",10,0)
 ;
"RTN","YTRPWRP",11,0)
INTRMNT(ROOT,YSDFN,YSXT) ; -- return report text
"RTN","YTRPWRP",12,0)
 ;ROOT=Where you want it
"RTN","YTRPWRP",13,0)
 ;YSDFN=Patient DFN
"RTN","YTRPWRP",14,0)
 ;YSXT= DATE TEST TAKEN,POINTER TO MH INSTRUMENT FILE #601
"RTN","YTRPWRP",15,0)
 ;  RPC: MH INTRUMENT REPORT TEXT
"RTN","YTRPWRP",16,0)
 ;
"RTN","YTRPWRP",17,0)
 ; -- init output global for close logic of WORKSTATION device
"RTN","YTRPWRP",18,0)
 N YSTOUT,YSUOUT,YSTEST,YSED,YSET,DFN,YSROU,YSN,LEN,YSBLNK S (YSTOUT,YSUOUT,YSN)=0,DFN=+YSDFN,$P(YSBLNK," ",60)=""
"RTN","YTRPWRP",19,0)
 S %=$H>21549+$H-.1,%Y=%\365.25+141,%=%#365.25\1,YSPTD=%+306#(%Y#4=0+365)#153#61#31+1,YSPTM=%-YSPTD\29+1,Y=%Y_"00"+YSPTM_"00"+YSPTD,YSDT(0)=$$FMTE^XLFDT(Y,"5ZD")
"RTN","YTRPWRP",20,0)
 D DEM^VADPT,PID^VADPT S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID"),YSSX=YSSEX
"RTN","YTRPWRP",21,0)
 S YSHDR=YSSSN_"  "_YSNM_YSBLNK,YSHDR=$E(YSHDR,1,44)_YSSEX_" AGE "_YSAGE,YSHD=DT
"RTN","YTRPWRP",22,0)
 K ^TMP("YSDATA",$J)
"RTN","YTRPWRP",23,0)
 S ROOT=$NA(^TMP("YSDATA",$J,1))
"RTN","YTRPWRP",24,0)
 ; -- get report text
"RTN","YTRPWRP",25,0)
 D START(132,"RP1^YTDP")
"RTN","YTRPWRP",26,0)
 Q
"RTN","YTRPWRP",27,0)
 ;
"RTN","YTRPWRP",28,0)
START(RM,GOTO) ;
"RTN","YTRPWRP",29,0)
 ;RM=Right margin
"RTN","YTRPWRP",30,0)
 S:'$G(RM) RM=80
"RTN","YTRPWRP",31,0)
 N ZTQUEUED,YSHFS,YSSUB,YSIO
"RTN","YTRPWRP",32,0)
 K ^TMP("YSDATA",$J)
"RTN","YTRPWRP",33,0)
 S ROOT=$NA(^TMP("YSDATA",$J,1))
"RTN","YTRPWRP",34,0)
 S YSHFS=$$HFS(),YSSUB="YSDATA"
"RTN","YTRPWRP",35,0)
 D OPEN(.RM,.YSHFS,"W",.YSIO)
"RTN","YTRPWRP",36,0)
 D @GOTO
"RTN","YTRPWRP",37,0)
 D CLOSE(.YSRM,.YSHFS,.YSSUB,.YSIO)
"RTN","YTRPWRP",38,0)
 Q
"RTN","YTRPWRP",39,0)
HFS() ; -- get hfs file name
"RTN","YTRPWRP",40,0)
 ; -- need to define better unique algorithm
"RTN","YTRPWRP",41,0)
 Q "YSU_"_$J_".DAT"
"RTN","YTRPWRP",42,0)
 ;
"RTN","YTRPWRP",43,0)
OPEN(YSRM,YSHFS,YSMODE,YSIO) ; -- open WORKSTATION device
"RTN","YTRPWRP",44,0)
 ;   YSRM: right margin
"RTN","YTRPWRP",45,0)
 ;  YSHFS: host file name
"RTN","YTRPWRP",46,0)
 ; YSMODE: open file in 'R'ead or 'W'rite mode
"RTN","YTRPWRP",47,0)
 S ZTQUEUED="" K IOPAR
"RTN","YTRPWRP",48,0)
 S IOP="OR WORKSTATION;"_$G(YSRM,80)_";66"
"RTN","YTRPWRP",49,0)
 S %ZIS("HFSMODE")=YSMODE,%ZIS("HFSNAME")=YSHFS
"RTN","YTRPWRP",50,0)
 D ^%ZIS
"RTN","YTRPWRP",51,0)
 K IOP,%ZIS
"RTN","YTRPWRP",52,0)
 U IO
"RTN","YTRPWRP",53,0)
 S YSIO=IO
"RTN","YTRPWRP",54,0)
 Q
"RTN","YTRPWRP",55,0)
 ;
"RTN","YTRPWRP",56,0)
CLOSE(YSRM,YSHFS,YSSUB,YSIO) ; -- close WORKSTATION device
"RTN","YTRPWRP",57,0)
 ; YSSUB: unique subscript name for output 
"RTN","YTRPWRP",58,0)
 I IO=YSIO D ^%ZISC
"RTN","YTRPWRP",59,0)
 U IO
"RTN","YTRPWRP",60,0)
 D USEHFS
"RTN","YTRPWRP",61,0)
 U IO
"RTN","YTRPWRP",62,0)
 Q
"RTN","YTRPWRP",63,0)
USEHFS ; -- use host file to build global array
"RTN","YTRPWRP",64,0)
 N IO,YSOK,SECTION
"RTN","YTRPWRP",65,0)
 S SECTION=0
"RTN","YTRPWRP",66,0)
 D INIT
"RTN","YTRPWRP",67,0)
 S YSOK=$$FTG^%ZISH(,YSHFS,$NA(@ROOT@(1)),4) I 'YSOK Q
"RTN","YTRPWRP",68,0)
 D STRIP
"RTN","YTRPWRP",69,0)
 N YSARR S YSARR(YSHFS)=""
"RTN","YTRPWRP",70,0)
 S YSOK=$$DEL^%ZISH("",$NA(YSARR))
"RTN","YTRPWRP",71,0)
 Q
"RTN","YTRPWRP",72,0)
 ;
"RTN","YTRPWRP",73,0)
INIT ; -- initialize counts and global section
"RTN","YTRPWRP",74,0)
 S (INC,CNT)=0,SECTION=SECTION+1
"RTN","YTRPWRP",75,0)
 S ROOT=$NA(^TMP(YSSUB,$J,SECTION))
"RTN","YTRPWRP",76,0)
 K @ROOT
"RTN","YTRPWRP",77,0)
 Q
"RTN","YTRPWRP",78,0)
 ;
"RTN","YTRPWRP",79,0)
STRIP ; -- strip off control chars
"RTN","YTRPWRP",80,0)
 N I,X
"RTN","YTRPWRP",81,0)
 S I=0 F  S I=$O(@ROOT@(I)) Q:'I  S X=^(I) D
"RTN","YTRPWRP",82,0)
 . I X[$C(8) D  ;BS
"RTN","YTRPWRP",83,0)
 .. I $L(X,$C(8))=$L(X,$C(95)) S (X,@ROOT@(I))=$TR(X,$C(8,95),"") Q  ;BS & _
"RTN","YTRPWRP",84,0)
 .. S (X,@ROOT@(I))=$TR(X,$C(8),"")
"RTN","YTRPWRP",85,0)
 . I X[$C(7)!(X[$C(12)) S @ROOT@(I)=$TR(X,$C(7,12),"") ;BEL or FF
"RTN","YTRPWRP",86,0)
 . I X[$C(12)&(I>7) S @ROOT@(I+.5)="***eop***"_$C(10) ;asf 4/18/08
"RTN","YTRPWRP",87,0)
 Q
"RTN","YTRPWRP",88,0)
 ;
"RTN","YTRPWRP",89,0)
TESTCODE(ROOT) ;YTRP LIST TEST/CODE
"RTN","YTRPWRP",90,0)
 N A S A="C"
"RTN","YTRPWRP",91,0)
 D START(132,"ENP^YTLCTD")
"RTN","YTRPWRP",92,0)
 Q
"RTN","YTRPWRP",93,0)
TESTDES(ROOT) ;YTRP LIST TEST/DESC
"RTN","YTRPWRP",94,0)
 N A S A="D"
"RTN","YTRPWRP",95,0)
 D START(132,"ENP^YTLCTD")
"RTN","YTRPWRP",96,0)
 Q
"RTN","YTRPWRP",97,0)
TESTTL(ROOT) ;YTRP LIST TEST/TITLE
"RTN","YTRPWRP",98,0)
 N A S A="T"
"RTN","YTRPWRP",99,0)
 D START(132,"ENP^YTLCTD")
"RTN","YTRPWRP",100,0)
 Q
"RTN","YTRPWRP",101,0)
 ;
"RTN","YTRPWRP",102,0)
 ; Hrubovcak - 30 March 2012
"RTN","YTRPWRP",103,0)
 ;
"RTN","YTRPWRP",104,0)
AL60193 ; strip control chars. from all entries in MH REPORT (#601.93)
"RTN","YTRPWRP",105,0)
 ;
"RTN","YTRPWRP",106,0)
 D DT^DICRW
"RTN","YTRPWRP",107,0)
 N YSI S YSI=0
"RTN","YTRPWRP",108,0)
 F  S YSI=$O(^YTT(601.93,YSI)) Q:'(YSI>0)  D:$O(^YTT(601.93,YSI,1,0))  ; if W-P field exists
"RTN","YTRPWRP",109,0)
 .L +^YTT(601.93,YSI):DILOCKTM E  Q  ; exclusive access
"RTN","YTRPWRP",110,0)
 .D RMVCC(YSI) L -^YTT(601.93,YSI)
"RTN","YTRPWRP",111,0)
 ;
"RTN","YTRPWRP",112,0)
 Q
"RTN","YTRPWRP",113,0)
 ;
"RTN","YTRPWRP",114,0)
RMVCC(YSIEN) ; remove control chars. from W-P field in MH REPORT (#601.93)
"RTN","YTRPWRP",115,0)
 ; entry should be LOCKed before call
"RTN","YTRPWRP",116,0)
 N J,X,Y  ; X=original, Y=fixed
"RTN","YTRPWRP",117,0)
 S J=0
"RTN","YTRPWRP",118,0)
 F  S J=$O(^YTT(601.93,YSIEN,1,J)) Q:'J  S X=$G(^YTT(601.93,YSIEN,1,J,0)) I X]"" S Y=X D
"RTN","YTRPWRP",119,0)
 .N FLAG  ; indicates what was done
"RTN","YTRPWRP",120,0)
 .I Y[$C(8) D  ; backspace
"RTN","YTRPWRP",121,0)
 ..I $L(Y,$C(8))=$L(Y,$C(95)) S Y=$TR(Y,$C(8,95),""),FLAG("BSUN")=1 Q  ; backspace & underscore
"RTN","YTRPWRP",122,0)
 ..S Y=$TR(Y,$C(8),""),FLAG("BS")=1  ; backspace
"RTN","YTRPWRP",123,0)
 .;
"RTN","YTRPWRP",124,0)
 .I Y[$C(7)!(Y[$C(12)) S:Y[$C(12) FLAG("FF")=1 S:Y[$C(7) FLAG("BELL")=1 S Y=$TR(Y,$C(7,12),"") ; bell or form feed
"RTN","YTRPWRP",125,0)
 .Q:Y=X  ; no changes
"RTN","YTRPWRP",126,0)
 .S ^YTT(601.93,YSIEN,1,J,0)=Y
"RTN","YTRPWRP",127,0)
 .I J>7,$G(FLAG("FF")) S ^YTT(601.93,YSIEN,1,J+.5,0)="***eop***"_$C(10)
"RTN","YTRPWRP",128,0)
 ;
"RTN","YTRPWRP",129,0)
 Q
"RTN","YTRPWRP",130,0)
 ;
"RTN","YTS")
0^156^B16658002
"RTN","YTS",1,0)
YTS ;SLC/DKG,TGA,HIOFO/FT - START TESTS, QUESTIONNAIRES & REPORTS ;9/29/11 17:01
"RTN","YTS",2,0)
 ;;5.01;MENTAL HEALTH;**37,54,60**;Dec 30, 1994;Build 47
"RTN","YTS",3,0)
 ;
"RTN","YTS",4,0)
 ;Reference to ^XUSEC( supported by DBIA #10076
"RTN","YTS",5,0)
 ;Reference to ^DPT( supported by DBIA #10035
"RTN","YTS",6,0)
 ;Reference to ^XLFDT APIs supported by DBIA #10103
"RTN","YTS",7,0)
 ;Reference to %ZISC supported by IA #10089
"RTN","YTS",8,0)
 ;
"RTN","YTS",9,0)
 ; 7 June 2011
"RTN","YTS",10,0)
 ;
"RTN","YTS",11,0)
 ;ADM ; Called by MENU option YSADMTEST
"RTN","YTS",12,0)
 ;Q  ; disabled by Patch 60
"RTN","YTS",13,0)
 ;D ^YSLRP G:YSDFN<1 END S:'$D(^YTD(601.2,"B",YSDFN,YSDFN)) ^(YSDFN)=""
"RTN","YTS",14,0)
C ;
"RTN","YTS",15,0)
 I $P(^DPT(YSDFN,0),U,2)']"" W !!,"Patient's SEX required to administer instruments!" Q
"RTN","YTS",16,0)
 D ENPT^YSUTL,NX G ^YTAR
"RTN","YTS",17,0)
 ;
"RTN","YTS",18,0)
RPT ; Called by MENU option YSPRINT
"RTN","YTS",19,0)
 ; disabled by Patch 60
"RTN","YTS",20,0)
 Q  D ^YSLRP G:YSDFN<1 END S YSNO=1 D NX G ^YTDP
"RTN","YTS",21,0)
NX ;
"RTN","YTS",22,0)
 S %=$H>21549+$H-.1,%Y=%\365.25+141,%=%#365.25\1,YSPTD=%+306#(%Y#4=0+365)#153#61#31+1,YSPTM=%-YSPTD\29+1,Y=%Y_"00"+YSPTM_"00"+YSPTD,YSDT(0)=$$FMTE^XLFDT(Y,"5ZD")
"RTN","YTS",23,0)
 S YSSX=YSSEX,YSBL="           ",YSHDR=YSSSN_"  "_YSNM_YSBL_YSBL_YSBL,YSHDR=$E(YSHDR,1,44)_YSSX_" AGE "_YSAGE_" "_YSDT(0),YSHD=DT
"RTN","YTS",24,0)
 S YSRSLMT=$P($G(^YSA(602,1,0)),U,3)
"RTN","YTS",25,0)
 I $G(A9)="A" G NX1
"RTN","YTS",26,0)
 W @IOF,!!?2,YSHDR
"RTN","YTS",27,0)
NX1 ;
"RTN","YTS",28,0)
 S YSHDT="" Q:$D(YSXT)
"RTN","YTS",29,0)
 S T2=$S($D(^XUSEC("YSP",DUZ)):0,1:2)
"RTN","YTS",30,0)
 S N=0 F  S N=$O(^YTD(601.2,YSDFN,1,N)) Q:'N  I $D(^YTT(601,N)) S N2=0 F  S N2=$O(^YTD(601.2,YSDFN,1,N,1,N2)) Q:'N2  D CK
"RTN","YTS",31,0)
 S YSNT=0,N1="" F  S N1=$O(A(N1)) Q:N1=""  S N2="" F  S N2=$O(A(N1,N2)) Q:N2=""  S YSNT=YSNT+1,A1(YSNT)=N1_"^"_N2_"^"_A(N1,N2) I N1="MMPI",$D(^YTD(601.2,YSDFN,1,A(N1,N2),1,N2,99)),^(99)="MMPIR" S A1(YSNT,"R")="R"
"RTN","YTS",32,0)
 Q
"RTN","YTS",33,0)
CK ;
"RTN","YTS",34,0)
 S X=^YTT(601,N,0),N4=$P(X,U),X9=$P(X,U,9) G:$P(X,U,10)="Y" CK1
"RTN","YTS",35,0)
 I X9="T",T2>1,$D(YSNO) Q
"RTN","YTS",36,0)
 I X9="T",$P(X,U,8)'="V",T2>0,$D(YSNO) Q
"RTN","YTS",37,0)
CK1 ;
"RTN","YTS",38,0)
 S A(N4,N2)=N Q
"RTN","YTS",39,0)
KAR ;
"RTN","YTS",40,0)
 I $D(YSTXTED),$G(YSLFT) S YSTXTED=1
"RTN","YTS",41,0)
 K %ZIS,%Y,A,A1,B,B1,C,D0,DA,DIC,DIE,DQ,DR,DTOUT,DUOUT,H,I,I0,J,K,L,M,N,N1,N2,N3,N4,P0,P1,P3,R1,T,T1,T2,X0,X1,X3,X4,X7,X8,X9,XMB,XMDUZ,Y1,Y2,YS4D,YSAGE,YSBAT,YSBEGIN,YSBL,YSCD,YSCH,YSCHN,YSCL,YSCLN,YSCON
"RTN","YTS",42,0)
 K YSDEMO,YSDTA,YSDTM,YSDOB,YSED,YSEN,YSENT,YSET,YSFHDR,YSFTR,YSHD,YSHDR,YSHDT,YSJT,YSLFT,YSLN,YSNM,YSNO,YSNQ,YSNT
"RTN","YTS",43,0)
 K YSNX,YSOK,YSORD,YSORDD,YSORDP,YSPTM,YSRESTRT,YSRP,YSSEX,YSQ,YSSSN,YSSX,YSTEST,YSTESTN,YSTF,YSTIN,YSTM,YSTX,YSTY,YSXTP,YSYI,YSYTX,YSZZ,Z,Z1,Z3
"RTN","YTS",44,0)
END ;
"RTN","YTS",45,0)
 K %,%DT,A9,X,Y,YSCLERK,YSD,YSDFN,YSPTD,YSRSLMT,YSXT,ZTSK D ^%ZISC
"RTN","YTS",46,0)
 Q
"RTN","YTS",47,0)
 ;
"RTN","YTS",48,0)
HX2F ;
"RTN","YTS",49,0)
 S YSNT=0,N1=$O(^YTT(601,"B",YSXT,0)) Q:N1'>0  I $D(^YTD(601.2,+YSDFN,1,"B",N1)) S N=$O(^(N1,0)) F N3=0:0 S N3=$O(^YTD(601.2,+YSDFN,1,N,1,N3)) Q:'N3  D HX2FS
"RTN","YTS",50,0)
 Q
"RTN","YTS",51,0)
HX2FS ;
"RTN","YTS",52,0)
 S YSNT=YSNT+1,A1(YSNT)=YSXT_"^"_N3_"^"_N Q
"RTN","YTS",53,0)
 ;
"RTN","YTS",54,0)
 ;ENT ; Called by MENU option YSCLERK
"RTN","YTS",55,0)
 ; disabled by Patch 60
"RTN","YTS",56,0)
 ;Q  S YSCLERK=$O(^YTT(601,"B","CLERK",0)) G ADM ;CLERK ENTRY
"RTN","YTS",57,0)
 ;
"RTN","YTS",58,0)
 ;ENSTAF ; Called by MENU option YSDIRTEST
"RTN","YTS",59,0)
 ; disabled by Patch 60
"RTN","YTS",60,0)
 ;Q  S YSM=1 G ADM
"RTN","YTS",61,0)
INT ;
"RTN","YTS",62,0)
 D ^YSLRP G:YSDFN<1 END D C:$P(YSDFN(0),U,2)="" G:YSDFN<1 END S YSXTP=1 D NX,HX2F S T1=1,YSXT=$O(^YTT(601,"B",YSXT,0)),T1(0)=$P(^YTT(601,YSXT,"P"),U,4) G ^YTAR:A9="A",^YTDP
"RTN","YTS",63,0)
 Q
"RTN","YTS",64,0)
 ;
"RTN","YTS",65,0)
 ;HX2A ; Called by MENU option YSHXPAST
"RTN","YTS",66,0)
 ;S YSXT="HX2",A9="A" G INT
"RTN","YTS",67,0)
 ;
"RTN","YTS",68,0)
 ;HX2R ; Called by MENU option YSHXPASTR
"RTN","YTS",69,0)
 ;S YSXT="HX2",A9="R" G INT
"RTN","YTS",70,0)
 ;
"RTN","YTS",71,0)
 ;MROSA ; Called by MENU option YSREVSYS
"RTN","YTS",72,0)
 ;S YSXT="MROS",A9="A" G INT
"RTN","YTS",73,0)
 ;
"RTN","YTS",74,0)
 ;MROSR ; Called by MENU option YSREVSYSR
"RTN","YTS",75,0)
 ;S YSXT="MROS",A9="R" G INT
"RTN","YTS",76,0)
 ;
"RTN","YTS",77,0)
 ;PSOCA ; Called by MENU option YSPERSHX
"RTN","YTS",78,0)
 ;S YSXT="PSOC",A9="A" G INT
"RTN","YTS",79,0)
 ;
"RTN","YTS",80,0)
 ;PSOCR ; Called by MENU option YSPERSHXR
"RTN","YTS",81,0)
 ;S YSXT="PSOC",A9="R" G INT
"RTN","YTS",82,0)
 ;
"RTN","YTS",83,0)
BECK ; Called by YTAR -> BECK msg.
"RTN","YTS",84,0)
 I YSTESTN="BECK" D  ; modification made 11/2/94 mjd
"RTN","YTS",85,0)
 .  W !!,"You have selected the ""BECK"" instrument, the ""BDI"" "
"RTN","YTS",86,0)
 .  W !,"instrument will be administered in its place.",!
"RTN","YTS",87,0)
 .  S YSTESTN="BDI"
"RTN","YTS",88,0)
 Q
"RTN","YTS",89,0)
 ;
"RTN","YTS",90,0)
MMPI ; Called by YTAR -> MMPI msg.
"RTN","YTS",91,0)
 I YSTESTN="MMPI" D  ; modification made 08/08/99 mjd
"RTN","YTS",92,0)
 .  W !!,"You have selected the ""MMPI"" instrument, the ""MMPI2"" "
"RTN","YTS",93,0)
 .  W !,"instrument will be administered in its place.",!
"RTN","YTS",94,0)
 .  S YSTESTN="MMPI2"
"RTN","YTS",95,0)
 Q
"RTN","YTTB")
1^255
"VER")
8.0^22.0
**INSTALL NAME**
GMTS*2.7*102
"BLD",19537,0)
GMTS*2.7*102^HEALTH SUMMARY^0^3120815^y
"BLD",19537,1,0)
^^5^5^3111114^
"BLD",19537,1,1,0)
The Mental Health Package is removing file #90 as part of a cleanup 
"BLD",19537,1,2,0)
project. This patch will permanently deactivate the MENTAL HEALTH 
"BLD",19537,1,3,0)
PHYSICAL EXAM health summary component, rebuild the Health Summary Ad Hoc 
"BLD",19537,1,4,0)
Report, and create a report of Health Summary Types and Objects that used 
"BLD",19537,1,5,0)
the MENTAL HEALTH PHYSICAL EXAM component.
"BLD",19537,4,0)
^9.64PA^^
"BLD",19537,6.3)
25
"BLD",19537,"INI")
PRE^GMTSP102
"BLD",19537,"INID")
^y^n
"BLD",19537,"INIT")
POST^GMTSP102
"BLD",19537,"KRN",0)
^9.67PA^779.2^20
"BLD",19537,"KRN",.4,0)
.4
"BLD",19537,"KRN",.401,0)
.401
"BLD",19537,"KRN",.402,0)
.402
"BLD",19537,"KRN",.403,0)
.403
"BLD",19537,"KRN",.5,0)
.5
"BLD",19537,"KRN",.84,0)
.84
"BLD",19537,"KRN",3.6,0)
3.6
"BLD",19537,"KRN",3.8,0)
3.8
"BLD",19537,"KRN",3.8,"NM",0)
^9.68A^^
"BLD",19537,"KRN",9.2,0)
9.2
"BLD",19537,"KRN",9.8,0)
9.8
"BLD",19537,"KRN",9.8,"NM",0)
^9.68A^1^1
"BLD",19537,"KRN",9.8,"NM",1,0)
GMTSMHPE^^0^B21341517
"BLD",19537,"KRN",9.8,"NM","B","GMTSMHPE",1)

"BLD",19537,"KRN",19,0)
19
"BLD",19537,"KRN",19.1,0)
19.1
"BLD",19537,"KRN",101,0)
101
"BLD",19537,"KRN",409.61,0)
409.61
"BLD",19537,"KRN",771,0)
771
"BLD",19537,"KRN",779.2,0)
779.2
"BLD",19537,"KRN",870,0)
870
"BLD",19537,"KRN",8989.51,0)
8989.51
"BLD",19537,"KRN",8989.52,0)
8989.52
"BLD",19537,"KRN",8994,0)
8994
"BLD",19537,"KRN","B",.4,.4)

"BLD",19537,"KRN","B",.401,.401)

"BLD",19537,"KRN","B",.402,.402)

"BLD",19537,"KRN","B",.403,.403)

"BLD",19537,"KRN","B",.5,.5)

"BLD",19537,"KRN","B",.84,.84)

"BLD",19537,"KRN","B",3.6,3.6)

"BLD",19537,"KRN","B",3.8,3.8)

"BLD",19537,"KRN","B",9.2,9.2)

"BLD",19537,"KRN","B",9.8,9.8)

"BLD",19537,"KRN","B",19,19)

"BLD",19537,"KRN","B",19.1,19.1)

"BLD",19537,"KRN","B",101,101)

"BLD",19537,"KRN","B",409.61,409.61)

"BLD",19537,"KRN","B",771,771)

"BLD",19537,"KRN","B",779.2,779.2)

"BLD",19537,"KRN","B",870,870)

"BLD",19537,"KRN","B",8989.51,8989.51)

"BLD",19537,"KRN","B",8989.52,8989.52)

"BLD",19537,"KRN","B",8994,8994)

"BLD",19537,"PRE")

"BLD",19537,"QUES",0)
^9.62^1^1
"BLD",19537,"QUES",1,0)
PRE1
"BLD",19537,"QUES",1,1)
Y^
"BLD",19537,"QUES",1,"A")
do you want to include disabled components
"BLD",19537,"QUES",1,"A1",0)
^^1^1^3111116^
"BLD",19537,"QUES",1,"A1",1,0)
When rebuilding the Health Summary Adhoc Report,
"BLD",19537,"QUES",1,"Q")
Answer YES to include disabled components, NO to exclude them.
"BLD",19537,"QUES","B","PRE1",1)

"BLD",19537,"REQB",0)
^9.611^1^1
"BLD",19537,"REQB",1,0)
GMTS*2.7*49^2
"BLD",19537,"REQB","B","GMTS*2.7*49",1)

"INI")
PRE^GMTSP102
"INIT")
POST^GMTSP102
"MBREQ")
0
"PKG",56,-1)
1^1
"PKG",56,0)
HEALTH SUMMARY^GMTS^Integrated Health Summary Tools
"PKG",56,22,0)
^9.49I^1^1
"PKG",56,22,1,0)
2.7^2951020^2960605
"PKG",56,22,1,"PAH",1,0)
102^3120815^547
"PKG",56,22,1,"PAH",1,1,0)
^^5^5^3120815
"PKG",56,22,1,"PAH",1,1,1,0)
The Mental Health Package is removing file #90 as part of a cleanup 
"PKG",56,22,1,"PAH",1,1,2,0)
project. This patch will permanently deactivate the MENTAL HEALTH 
"PKG",56,22,1,"PAH",1,1,3,0)
PHYSICAL EXAM health summary component, rebuild the Health Summary Ad Hoc 
"PKG",56,22,1,"PAH",1,1,4,0)
Report, and create a report of Health Summary Types and Objects that used 
"PKG",56,22,1,"PAH",1,1,5,0)
the MENTAL HEALTH PHYSICAL EXAM component.
"QUES","PRE1",0)
Y^
"QUES","PRE1","?")
Answer YES to include disabled components, NO to exclude them.
"QUES","PRE1","A")
do you want to include disabled components
"QUES","PRE1","A",1)
When rebuilding the Health Summary Adhoc Report,
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
2
"RTN","GMTSMHPE")
0^1^B21341517
"RTN","GMTSMHPE",1,0)
GMTSMHPE ; SLC/JER,KER - Mental Health Physical Exam Component ; 11/14/2011
"RTN","GMTSMHPE",2,0)
 ;;2.7;Health Summary;**49,102**;Oct 20, 1995;Build 25
"RTN","GMTSMHPE",3,0)
 ;                     
"RTN","GMTSMHPE",4,0)
 ; External References
"RTN","GMTSMHPE",5,0)
 ;   DBIA  1280  ^MR(    (file #90)
"RTN","GMTSMHPE",6,0)
 ;   DBIA 10015  EN^DIQ1 (file #90)
"RTN","GMTSMHPE",7,0)
 ;                    
"RTN","GMTSMHPE",8,0)
MAIN ; Main control
"RTN","GMTSMHPE",9,0)
 Q
"RTN","GMTSMHPE",10,0)
 N GMCKC,GMDATA,GMDATE,GMEND,GMTSE,GMTSB,GMFLD,GMI,GMIL,GMTIMES,GMX,MAX Q:'$G(DFN)  Q:'$D(^MR(+DFN,"PE"))
"RTN","GMTSMHPE",11,0)
 S GMTSB=$G(GMTS1) S:GMTSB'?7N GMTSB=6666666 S GMTSE=$G(GMTS2) S:GMTSE'?7N GMTSE=9999999
"RTN","GMTSMHPE",12,0)
 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
"RTN","GMTSMHPE",13,0)
 S GMTIMES=0
"RTN","GMTSMHPE",14,0)
PHYEXAM ; Check for existence of PHYSICAL EXAM data
"RTN","GMTSMHPE",15,0)
 Q
"RTN","GMTSMHPE",16,0)
 S GMEND=GMTSE S GMDATE=GMTSB-.1
"RTN","GMTSMHPE",17,0)
 F  S GMDATE=$O(^MR(+DFN,"PE",GMDATE)) Q:GMDATE']""!(GMDATE>GMEND)  D  Q:$D(GMTSQIT)!(MAX'>GMTIMES)
"RTN","GMTSMHPE",18,0)
 . N DIC,DIQ,DA,DR
"RTN","GMTSMHPE",19,0)
 . K ^UTILITY("DIQ1",$J)
"RTN","GMTSMHPE",20,0)
 . S DIC="^MR(",DA=+DFN,DR=100,DIQ(0)="EN"
"RTN","GMTSMHPE",21,0)
 . S DR(90.01)=".01:34",DA(90.01)=+GMDATE,DR(90.02)=.01,DA(90.02)=0
"RTN","GMTSMHPE",22,0)
 . S DR(90.03)=.01,DA(90.03)=0
"RTN","GMTSMHPE",23,0)
 . D EN^DIQ1
"RTN","GMTSMHPE",24,0)
 . Q:'$D(^UTILITY("DIQ1",$J))
"RTN","GMTSMHPE",25,0)
 . S GMTIMES=GMTIMES+1
"RTN","GMTSMHPE",26,0)
 . D VS(+DFN,+GMDATE) Q:$D(GMTSQIT)
"RTN","GMTSMHPE",27,0)
 . D OMITABN
"RTN","GMTSMHPE",28,0)
 . D SHOWOMIT Q:$D(GMTSQIT)
"RTN","GMTSMHPE",29,0)
 . D SHOWABN Q:$D(GMTSQIT)
"RTN","GMTSMHPE",30,0)
 . W !
"RTN","GMTSMHPE",31,0)
 K ^UTILITY("DIQ1",$J)
"RTN","GMTSMHPE",32,0)
 Q
"RTN","GMTSMHPE",33,0)
 ;
"RTN","GMTSMHPE",34,0)
VS(DFN,GMDATE) ; Show vital signs
"RTN","GMTSMHPE",35,0)
 N GMI,GMTXT D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","GMTSMHPE",36,0)
 W "VITAL SIGNS DATE: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.01,"E"))]"":^("E"),1:"Unknown")
"RTN","GMTSMHPE",37,0)
 W ?40,"Examiner: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,29,"E"))]"":^("E"),1:"Unknown")
"RTN","GMTSMHPE",38,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","GMTSMHPE",39,0)
 W !,"Temp: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.04,"E")):^("E")_"F",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,34,"E")):^("E")_"C",1:"")
"RTN","GMTSMHPE",40,0)
 W ?14,"Pulse: ",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.05,"E"))
"RTN","GMTSMHPE",41,0)
 W ?28,"Resp: ",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.07,"E"))
"RTN","GMTSMHPE",42,0)
 W ?42,"BP: ",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.06,"E"))
"RTN","GMTSMHPE",43,0)
 W ?56,"Ht: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.02,"E")):^("E")_"in",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,32,"E")):^("E")_"cm",1:"")
"RTN","GMTSMHPE",44,0)
 W ?70,"Wt: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.03,"E")):^("E")_"lb",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,33,"E")):^("E")_"kg",1:""),!!
"RTN","GMTSMHPE",45,0)
 I +$O(^MR(+DFN,"PE",+GMDATE,19,0)) D  Q:$D(GMTSQIT)  W !
"RTN","GMTSMHPE",46,0)
 . W "Comments:",!
"RTN","GMTSMHPE",47,0)
 . S GMI=0 F  S GMI=$O(^MR(+DFN,"PE",+GMDATE,19,GMI)) Q:GMI'>0  D  Q:$D(GMTSQIT)
"RTN","GMTSMHPE",48,0)
 . . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?4,$G(^MR(+DFN,"PE",+GMDATE,19,GMI,0)),!
"RTN","GMTSMHPE",49,0)
 I +$O(^MR(+DFN,"PE",+GMDATE,20,0)) D  Q:$D(GMTSQIT)  W !
"RTN","GMTSMHPE",50,0)
 . W "Initial Impression:",!  S GMI=0
"RTN","GMTSMHPE",51,0)
 . F  S GMI=$O(^MR(+DFN,"PE",+GMDATE,20,GMI)) Q:GMI'>0  D  Q:$D(GMTSQIT)
"RTN","GMTSMHPE",52,0)
 . . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?4,$G(^MR(+DFN,"PE",+GMDATE,20,GMI,0)),!
"RTN","GMTSMHPE",53,0)
 S GMTXT=$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.9,"E")) Q:GMTXT']""
"RTN","GMTSMHPE",54,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)  W "General Appearance: "
"RTN","GMTSMHPE",55,0)
 I $L(GMTXT)>59 S GMTXT=$$WRAP^GMTSORC(GMTXT,60)
"RTN","GMTSMHPE",56,0)
 F GMI=1:1:$L(GMTXT,"|") D CKP^GMTSUP Q:$D(GMTSQIT)  W:$P(GMTXT,"|",GMI)]"" ?20,$P(GMTXT,"|",GMI),!
"RTN","GMTSMHPE",57,0)
 W !
"RTN","GMTSMHPE",58,0)
 Q
"RTN","GMTSMHPE",59,0)
OMITABN ; Get PHYSICAL EXAM 'Omits' and 'Abnormals'
"RTN","GMTSMHPE",60,0)
 N GMFLD,GMX K GMDATA F GMFLD=2:1:19 D
"RTN","GMTSMHPE",61,0)
 . S GMX=$E($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,+GMFLD,"E")))
"RTN","GMTSMHPE",62,0)
 . Q:GMX'?1U  I GMX="O" S GMDATA("OM",+GMFLD)=$$SYS(+GMFLD)
"RTN","GMTSMHPE",63,0)
 . I GMX="A" S GMDATA("AB",+GMFLD)=$$SYS(+GMFLD)_"^"_$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,+GMFLD_.9,"E"))
"RTN","GMTSMHPE",64,0)
 Q
"RTN","GMTSMHPE",65,0)
 ;
"RTN","GMTSMHPE",66,0)
SHOWOMIT ;   Show 'Omits'
"RTN","GMTSMHPE",67,0)
 N GMYST,GMPHY D CKP^GMTSUP Q:$D(GMTSQIT)  W "Omissions: "
"RTN","GMTSMHPE",68,0)
 I '$D(GMDATA("OM")) W " None",!! Q
"RTN","GMTSMHPE",69,0)
 S GMYST=0 F  S GMYST=$O(GMDATA("OM",GMYST)) Q:GMYST'>0  D  Q:$D(GMTSQIT)
"RTN","GMTSMHPE",70,0)
 . S GMPHY=GMDATA("OM",GMYST) I (($L(GMPHY)+$X)>(IOM-2)) D CKP^GMTSUP Q:$D(GMTSQIT)  W !?11
"RTN","GMTSMHPE",71,0)
 . W GMPHY W:+$O(GMDATA("OM",GMYST)) ", "
"RTN","GMTSMHPE",72,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)  W !!
"RTN","GMTSMHPE",73,0)
 Q
"RTN","GMTSMHPE",74,0)
 ;
"RTN","GMTSMHPE",75,0)
SHOWABN ;   Show 'Abnormals'
"RTN","GMTSMHPE",76,0)
 N GMI,GMTXT,GMYST,GMPHY D CKP^GMTSUP Q:$D(GMTSQIT)  W "Abnormal Findings: "
"RTN","GMTSMHPE",77,0)
 I '$D(GMDATA("AB")) W " None",!! Q
"RTN","GMTSMHPE",78,0)
 W ! S GMYST=0 F  S GMYST=$O(GMDATA("AB",GMYST)) Q:GMYST'>0  D  Q:$D(GMTSQIT)
"RTN","GMTSMHPE",79,0)
 . S GMPHY=$P(GMDATA("AB",GMYST),"^",1) Q:GMPHY']""
"RTN","GMTSMHPE",80,0)
 . D CKP^GMTSUP Q:$D(GMTSQIT)  W:GMTSNPG " Abnormal Findings (cont'd):",! W ?(17-$L(GMPHY)),GMPHY,":"
"RTN","GMTSMHPE",81,0)
 . S GMTXT=$P(GMDATA("AB",GMYST),"^",2) Q:GMTXT']""
"RTN","GMTSMHPE",82,0)
 . I $L(GMTXT)>60 S GMTXT=$$WRAP^GMTSORC(GMTXT,60)
"RTN","GMTSMHPE",83,0)
 . F GMI=1:1:$L(GMTXT,"|") D CKP^GMTSUP Q:$D(GMTSQIT)  W:$P(GMTXT,"|",GMI)]"" ?19,$P(GMTXT,"|",GMI),!
"RTN","GMTSMHPE",84,0)
 W !
"RTN","GMTSMHPE",85,0)
 Q
"RTN","GMTSMHPE",86,0)
 ;
"RTN","GMTSMHPE",87,0)
SYS(GMHSYST) ; Physical System
"RTN","GMTSMHPE",88,0)
 S GMHSYST=$P("^Head^Eyes^Ears^Nose^Mouth^Neck^Chest&Breasts^Lungs^Heart^Abdomen^Genitalia^Pelvic^Rectum^Back^Extremities^Neurological^Skin^Lymph",U,GMHSYST)
"RTN","GMTSMHPE",89,0)
 Q GMHSYST
"RTN","GMTSP102")
0^^B15354358
"RTN","GMTSP102",1,0)
GMTSP102 ; SLC/RFR - Pre/Post Install GMTS*2.7*102 ; 11/04/2011
"RTN","GMTSP102",2,0)
 ;;2.7;Health Summary;**102**;;Build 25
"RTN","GMTSP102",3,0)
 ;
"RTN","GMTSP102",4,0)
PRE ;PRE-INSTALL
"RTN","GMTSP102",5,0)
 N GMTSIEN,GMTSFDA,GMTSERR,GMTSMSG,GMTSX,INCLUDE
"RTN","GMTSP102",6,0)
 S XPDIDTOT=2
"RTN","GMTSP102",7,0)
 D UPDATE^XPDID(0)
"RTN","GMTSP102",8,0)
 ;DEACTIVATE THE MENTAL HEALTH PHYSICAL EXAM COMPONENT
"RTN","GMTSP102",9,0)
 S GMTSIEN=$$GETIEN
"RTN","GMTSP102",10,0)
 Q:GMTSIEN=0
"RTN","GMTSP102",11,0)
 D BMES^XPDUTL("Deactivating the MENTAL HEALTH PHYSICAL EXAM component...")
"RTN","GMTSP102",12,0)
 S GMTSFDA(142.1,GMTSIEN_",",5)="P"
"RTN","GMTSP102",13,0)
 S GMTSFDA(142.1,GMTSIEN_",",8)="DEACTIVATED BY HEALTH SUMMARY PATCH GMTS*2.7*102"
"RTN","GMTSP102",14,0)
 L +^GMT(142.1,GMTSIEN):+$G(DILOCKTM)
"RTN","GMTSP102",15,0)
 I '$T D  Q
"RTN","GMTSP102",16,0)
 .S GMTSMSG(1)=" "
"RTN","GMTSP102",17,0)
 .S GMTSMSG(2)="Unable to lock the MENTAL HEALTH PHYSICAL EXAM component for editing."
"RTN","GMTSP102",18,0)
 .D MES^XPDUTL(.GMTSMSG)
"RTN","GMTSP102",19,0)
 .S XPDABORT=1
"RTN","GMTSP102",20,0)
 D FILE^DIE("","GMTSFDA","GMTSERR")
"RTN","GMTSP102",21,0)
 L -^GMT(142.1,GMTSIEN):+$G(DILOCKTM)
"RTN","GMTSP102",22,0)
 I $D(GMTSERR) D  Q
"RTN","GMTSP102",23,0)
 .S GMTSLINE=1
"RTN","GMTSP102",24,0)
 .S GMTSMSG(GMTSLINE)=" ",GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",25,0)
 .S GMTSMSG(GMTSLINE)="VA FileMan Error #"_GMTSERR("DIERR",1)_":",GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",26,0)
 .F GMTSX=1:1:+$O(GMTSERR("DIERR",1,"TEXT","A"),-1) D
"RTN","GMTSP102",27,0)
 ..S GMTSMSG(GMTSLINE)=GMTSERR("DIERR",1,"TEXT",GMTSX),GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",28,0)
 .D MES^XPDUTL(.GMTSMSG)
"RTN","GMTSP102",29,0)
 .S XPDABORT=1
"RTN","GMTSP102",30,0)
 D MES^XPDUTL("DONE")
"RTN","GMTSP102",31,0)
 D UPDATE^XPDID(1)
"RTN","GMTSP102",32,0)
 ;REBUILD THE ADHOC HEALTH SUMMARY TYPE, EXCLUDING ALL DISABLED COMPONENTS BY DEFAULT
"RTN","GMTSP102",33,0)
 S INCLUDE=$S($D(XPDQUES("PRE1"))>0:XPDQUES("PRE1"),1:0)
"RTN","GMTSP102",34,0)
 D ENPOST^GMTSLOAD
"RTN","GMTSP102",35,0)
 D UPDATE^XPDID(2)
"RTN","GMTSP102",36,0)
 Q
"RTN","GMTSP102",37,0)
POST ;POST-INSTALL
"RTN","GMTSP102",38,0)
 N GMTSLINE,GMTSREP,GMTSIEN,GMTSTIEN,GMTSOIEN,GMTSMSG
"RTN","GMTSP102",39,0)
 N XMMG,XMDUZ,XMY,XMSUB,XMTEXT,XMZ,XMERR,XPDIDTOT,DIFROM
"RTN","GMTSP102",40,0)
 S XPDIDTOT=1
"RTN","GMTSP102",41,0)
 D UPDATE^XPDID(0)
"RTN","GMTSP102",42,0)
 S GMTSIEN=$$GETIEN
"RTN","GMTSP102",43,0)
 Q:GMTSIEN=0
"RTN","GMTSP102",44,0)
 D BMES^XPDUTL("Assembling usage report...")
"RTN","GMTSP102",45,0)
 S GMTSLINE=1
"RTN","GMTSP102",46,0)
 S GMTSREP(GMTSLINE)="The following health summary types contain a reference to the",GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",47,0)
 S GMTSREP(GMTSLINE)="MENTAL HEALTH PHYSICAL EXAM component. The health summary objects",GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",48,0)
 S GMTSREP(GMTSLINE)="listed below each type contain a reference to that type.",GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",49,0)
 S GMTSREP(GMTSLINE)="",GMTSLINE=GMTSLINE+1,GMTSREP(GMTSLINE)="TYPE",GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",50,0)
 S GMTSREP(GMTSLINE)=$$REPEAT^XLFSTR(" ",12)_"OBJECTS CONTAINING THAT TYPE",GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",51,0)
 S GMTSREP(GMTSLINE)=$$REPEAT^XLFSTR("-",72),GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",52,0)
 S GMTSTIEN=0
"RTN","GMTSP102",53,0)
 F  S GMTSTIEN=$O(^GMT(142,"AE",GMTSIEN,GMTSTIEN)) Q:+$G(GMTSTIEN)=0  D
"RTN","GMTSP102",54,0)
 .S GMTSREP(GMTSLINE)=$P($G(^GMT(142,GMTSTIEN,0)),U,1)
"RTN","GMTSP102",55,0)
 .I $D(^GMT(142.5,"AC",GMTSTIEN))>9 D
"RTN","GMTSP102",56,0)
 ..S GMTSOIEN=0
"RTN","GMTSP102",57,0)
 ..F  S GMTSOIEN=$O(^GMT(142.5,"AC",GMTSTIEN,GMTSOIEN)) Q:+$G(GMTSOIEN)=0  D
"RTN","GMTSP102",58,0)
 ...S GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",59,0)
 ...S GMTSREP(GMTSLINE)=$$REPEAT^XLFSTR(" ",12)_$P($G(^GMT(142.5,GMTSOIEN,0)),U,1)
"RTN","GMTSP102",60,0)
 .S GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",61,0)
 S GMTSREP(GMTSLINE)="",GMTSLINE=GMTSLINE+1
"RTN","GMTSP102",62,0)
 S GMTSREP(GMTSLINE)=$$REPEAT^XLFSTR(" ",32)_"[END OF REPORT]"
"RTN","GMTSP102",63,0)
 S XMSUB="PATCH GMTS*2.7*102 REPORT"
"RTN","GMTSP102",64,0)
 S XMTEXT="GMTSREP("
"RTN","GMTSP102",65,0)
 I $D(ZTQUEUED)>0 D
"RTN","GMTSP102",66,0)
 .S XMY(DUZ)=""
"RTN","GMTSP102",67,0)
 E  D
"RTN","GMTSP102",68,0)
 .S GMTSMSG(1)=" "
"RTN","GMTSP102",69,0)
 .S GMTSMSG(2)="Select the recipient(s) of the report below."
"RTN","GMTSP102",70,0)
 .D MES^XPDUTL(.GMTSMSG)
"RTN","GMTSP102",71,0)
 D ^XMD
"RTN","GMTSP102",72,0)
 I $D(XMMG)>0 D  Q
"RTN","GMTSP102",73,0)
 .K GMTSMSG
"RTN","GMTSP102",74,0)
 .S GMTSMSG(1)=" "
"RTN","GMTSP102",75,0)
 .S GMTSMSG(2)="Unable to email the report:"
"RTN","GMTSP102",76,0)
 .S GMTSMSG(3)=XMMG
"RTN","GMTSP102",77,0)
 .D MES^XPDUTL(.GMTSMSG)
"RTN","GMTSP102",78,0)
 K GMTSMSG
"RTN","GMTSP102",79,0)
 S GMTSMSG(1)=" "
"RTN","GMTSP102",80,0)
 S GMTSMSG(2)="Finished assembling the usage report."
"RTN","GMTSP102",81,0)
 D MES^XPDUTL(.GMTSMSG)
"RTN","GMTSP102",82,0)
 D UPDATE^XPDID(1)
"RTN","GMTSP102",83,0)
 Q
"RTN","GMTSP102",84,0)
GETIEN() ;FIND THE COMPONENT'S IEN
"RTN","GMTSP102",85,0)
 N IEN
"RTN","GMTSP102",86,0)
 S IEN=+$O(^GMT(142.1,"B","MENTAL HEALTH PHYSICAL EXAM",0))
"RTN","GMTSP102",87,0)
 D:IEN=0 BMES^XPDUTL("MENTAL HEALTH PHYSICAL EXAM component was not found.")
"RTN","GMTSP102",88,0)
 Q IEN
"VER")
8.0^22.0
**END**
**END**