YSZ131 ;SLC/GDU - PATCH YS*5.01*113 CODE; 3/24/14 15:32
;;5.01;MENTAL HEALTH;**131**;Dec 30, 1994;Build 2
;Per VHA Directive 2004-038, this routine should not be modified
;Data Base Integration Agreement LIST
; EN^DDIOL DBIA # 10142
; $$FIND1^DIC DBIA # 2051
; FILE^DIE DBIA # 2053
; GETS^DIQ DBIA # 2056
; $$REPEAT^XLFSTR DBIA # 10104
; ^XMD DBIA # 10070
;Routine is to be called by entry point
Q
Q
EN ;Entry point
D EN1,SMM,KYSV
K YSCNT,YSFILE,YSMAIL,YSWAIT
Q
EN1 ;R14616270FY17 - CIWA question number 11 for headache not totaling.
S YSCNT=0,YSWAIT=1,YSFILE=601.91
S YSMSG(1)="Patch YS*5.01*131 Installation Messages",YSMSG(1,"F")="!"
S YSMSG(2)="R14616270FY17 - CIWA question number 11 for headache not totaling.",YSMSG(2,"F")="!"
S YSMSG(3)="MH SCORING KEY records #6189 and #9587 have Target fields with an incorrect",YSMSG(3,"F")="!"
S YSMSG(4)="value of 'Very Severe'. These records will be corrected with 'Very severe'.",YSMSG(4,"F")="!"
D UM
F YSIEN=6189,9587 D
. S YSIENS=YSIEN_","
. D GR I $D(YSFLD)=0 Q
. ;If the value is already corrected, alert user and quit loop
. I YSFLD(.01)=6189,YSFLD(3)="Very severe" D VAC,UM Q
. I YSFLD(.01)=9587,YSFLD(3)="Very severe" D VAC,UM Q
. ;Correct the value
. I YSFLD(.01)=6189 S YSFDA(YSFILE,YSIENS,3)="Very severe" D VIC,FILE^DIE("","YSFDA","YSERR")
. I YSFLD(.01)=9587 S YSFDA(YSFILE,YSIENS,3)="Very severe" D VIC,FILE^DIE("","YSFDA","YSERR")
. I $D(YSERR) S YSERL=6 D PEM
. D UM
. K YSIENS,YSERR,YSFDA
D KYSV
Q
;
VAC ;Value Already Correct
S YSMSG(5.1)="Value is already correct."
S YSMSG(5.1,"F")="!?8"
Q
;
VIC ;Value Is Corrected
S YSMSG(5.1)="Value will be set to the correct value of "_YSFDA(YSFILE,YSIENS,3)
S YSMSG(5.1,"F")="!?8"
Q
;
GR ;Get Record
I YSIEN="" Q
K YSFLD
D GETS^DIQ(YSFILE,YSIENS,"*","","YSREC","YSERR")
I $D(YSERR) D PEM G GRQ
M YSFLD=YSREC(YSFILE,YSIENS)
S YSMSG(1)="MH SCORING KEY # "_YSFLD(.01)
S YSMSG(1,"F")="!"
S YSMSG(2)="Target: "_YSFLD(3)
S YSMSG(2,"F")="!?4"
GRQ K YSERR,YSREC
Q
;
PEM ;Process Error Message
;Add Error Text to User Message
I '$D(YSERR) Q
I '$D(YSERL) S YSERL=1
S YSX=$P(YSERR("DIERR"),U)
F YSX1=1:1:YSX D
. S YSMSG(YSERL)="Error Code: "_YSERR("DIERR",YSX1)
. S YSMSG(YSERL,"F")="!"
. S YSX2=0
. F S YSX2=$O(YSERR("DIERR",YSX1,"TEXT",YSX2)) Q:YSX2="" D
. . S YSERL=YSERL+YSX2
. . S YSMSG(YSERL)=YSERR("DIERR",YSX1,"TEXT",YSX2)
. . S YSMSG(YSERL,"F")="!"
K YSERL,YSERR,YSX,YSX1,YSX2
Q
;
UM ;User Messages
;Display messages to the user
D EN^DDIOL(.YSMSG)
;Build MailMan Message from user messages
S YSX=0
F S YSX=$O(YSMSG(YSX)) Q:YSX="" D
. S YSX1=YSMSG(YSX)
. I YSMSG(YSX,"F")="!!" S YSCNT=YSCNT+1,YSMAIL(YSCNT)=""
. I YSMSG(YSX,"F")["?" D
. . S YSX2=$$REPEAT^XLFSTR(" ",$P(YSMSG(YSX,"F"),"?",2))
. . S YSX1=YSX2_YSX1
. S YSCNT=YSCNT+1
. S YSMAIL(YSCNT)=YSX1
K YSMSG,YSX,YSX1,YSX2
Q
;
SMM ;Send MailMan message to user
N DIFROM,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
S XMDUZ=.5
S XMSUB=YSMAIL(1)
S XMY(DUZ)=""
S XMTEXT="YSMAIL("
D ^XMD
I '$D(XMMG) D EN^DDIOL("Report successfully sent.","","!!")
Q
;
KYSV ;Kill YS Variables
K YSACI,YSDEX,YSERR,YSFDA,YSFLD,YSFLG,YSIEN
K YSIENS,YSML,YSMSG,YSREC,YSSCR,YSVAL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSZ131 3371 printed Sep 23, 2025@19:52:44 Page 2
YSZ131 ;SLC/GDU - PATCH YS*5.01*113 CODE; 3/24/14 15:32
+1 ;;5.01;MENTAL HEALTH;**131**;Dec 30, 1994;Build 2
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;Data Base Integration Agreement LIST
+4 ; EN^DDIOL DBIA # 10142
+5 ; $$FIND1^DIC DBIA # 2051
+6 ; FILE^DIE DBIA # 2053
+7 ; GETS^DIQ DBIA # 2056
+8 ; $$REPEAT^XLFSTR DBIA # 10104
+9 ; ^XMD DBIA # 10070
+10 ;Routine is to be called by entry point
+11 QUIT
+12 QUIT
EN ;Entry point
+1 DO EN1
DO SMM
DO KYSV
+2 KILL YSCNT,YSFILE,YSMAIL,YSWAIT
+3 QUIT
EN1 ;R14616270FY17 - CIWA question number 11 for headache not totaling.
+1 SET YSCNT=0
SET YSWAIT=1
SET YSFILE=601.91
+2 SET YSMSG(1)="Patch YS*5.01*131 Installation Messages"
SET YSMSG(1,"F")="!"
+3 SET YSMSG(2)="R14616270FY17 - CIWA question number 11 for headache not totaling."
SET YSMSG(2,"F")="!"
+4 SET YSMSG(3)="MH SCORING KEY records #6189 and #9587 have Target fields with an incorrect"
SET YSMSG(3,"F")="!"
+5 SET YSMSG(4)="value of 'Very Severe'. These records will be corrected with 'Very severe'."
SET YSMSG(4,"F")="!"
+6 DO UM
+7 FOR YSIEN=6189,9587
Begin DoDot:1
+8 SET YSIENS=YSIEN_","
+9 DO GR
IF $DATA(YSFLD)=0
QUIT
+10 ;If the value is already corrected, alert user and quit loop
+11 IF YSFLD(.01)=6189
IF YSFLD(3)="Very severe"
DO VAC
DO UM
QUIT
+12 IF YSFLD(.01)=9587
IF YSFLD(3)="Very severe"
DO VAC
DO UM
QUIT
+13 ;Correct the value
+14 IF YSFLD(.01)=6189
SET YSFDA(YSFILE,YSIENS,3)="Very severe"
DO VIC
DO FILE^DIE("","YSFDA","YSERR")
+15 IF YSFLD(.01)=9587
SET YSFDA(YSFILE,YSIENS,3)="Very severe"
DO VIC
DO FILE^DIE("","YSFDA","YSERR")
+16 IF $DATA(YSERR)
SET YSERL=6
DO PEM
+17 DO UM
+18 KILL YSIENS,YSERR,YSFDA
End DoDot:1
+19 DO KYSV
+20 QUIT
+21 ;
VAC ;Value Already Correct
+1 SET YSMSG(5.1)="Value is already correct."
+2 SET YSMSG(5.1,"F")="!?8"
+3 QUIT
+4 ;
VIC ;Value Is Corrected
+1 SET YSMSG(5.1)="Value will be set to the correct value of "_YSFDA(YSFILE,YSIENS,3)
+2 SET YSMSG(5.1,"F")="!?8"
+3 QUIT
+4 ;
GR ;Get Record
+1 IF YSIEN=""
QUIT
+2 KILL YSFLD
+3 DO GETS^DIQ(YSFILE,YSIENS,"*","","YSREC","YSERR")
+4 IF $DATA(YSERR)
DO PEM
GOTO GRQ
+5 MERGE YSFLD=YSREC(YSFILE,YSIENS)
+6 SET YSMSG(1)="MH SCORING KEY # "_YSFLD(.01)
+7 SET YSMSG(1,"F")="!"
+8 SET YSMSG(2)="Target: "_YSFLD(3)
+9 SET YSMSG(2,"F")="!?4"
GRQ KILL YSERR,YSREC
+1 QUIT
+2 ;
PEM ;Process Error Message
+1 ;Add Error Text to User Message
+2 IF '$DATA(YSERR)
QUIT
+3 IF '$DATA(YSERL)
SET YSERL=1
+4 SET YSX=$PIECE(YSERR("DIERR"),U)
+5 FOR YSX1=1:1:YSX
Begin DoDot:1
+6 SET YSMSG(YSERL)="Error Code: "_YSERR("DIERR",YSX1)
+7 SET YSMSG(YSERL,"F")="!"
+8 SET YSX2=0
+9 FOR
SET YSX2=$ORDER(YSERR("DIERR",YSX1,"TEXT",YSX2))
if YSX2=""
QUIT
Begin DoDot:2
+10 SET YSERL=YSERL+YSX2
+11 SET YSMSG(YSERL)=YSERR("DIERR",YSX1,"TEXT",YSX2)
+12 SET YSMSG(YSERL,"F")="!"
End DoDot:2
End DoDot:1
+13 KILL YSERL,YSERR,YSX,YSX1,YSX2
+14 QUIT
+15 ;
UM ;User Messages
+1 ;Display messages to the user
+2 DO EN^DDIOL(.YSMSG)
+3 ;Build MailMan Message from user messages
+4 SET YSX=0
+5 FOR
SET YSX=$ORDER(YSMSG(YSX))
if YSX=""
QUIT
Begin DoDot:1
+6 SET YSX1=YSMSG(YSX)
+7 IF YSMSG(YSX,"F")="!!"
SET YSCNT=YSCNT+1
SET YSMAIL(YSCNT)=""
+8 IF YSMSG(YSX,"F")["?"
Begin DoDot:2
+9 SET YSX2=$$REPEAT^XLFSTR(" ",$PIECE(YSMSG(YSX,"F"),"?",2))
+10 SET YSX1=YSX2_YSX1
End DoDot:2
+11 SET YSCNT=YSCNT+1
+12 SET YSMAIL(YSCNT)=YSX1
End DoDot:1
+13 KILL YSMSG,YSX,YSX1,YSX2
+14 QUIT
+15 ;
SMM ;Send MailMan message to user
+1 NEW DIFROM,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+2 SET XMDUZ=.5
+3 SET XMSUB=YSMAIL(1)
+4 SET XMY(DUZ)=""
+5 SET XMTEXT="YSMAIL("
+6 DO ^XMD
+7 IF '$DATA(XMMG)
DO EN^DDIOL("Report successfully sent.","","!!")
+8 QUIT
+9 ;
KYSV ;Kill YS Variables
+1 KILL YSACI,YSDEX,YSERR,YSFDA,YSFLD,YSFLG,YSIEN
+2 KILL YSIENS,YSML,YSMSG,YSREC,YSSCR,YSVAL
+3 QUIT
