YS158PST ;BAH/QSB - Patch 158 Post-Init ; 7/29/2020
;;5.01;MENTAL HEALTH;**158**;;Build 38
;
Q
POST ; Post-init for YS*5.01*158
D SSRRTN
Q
;
SSRRTN ; Set the Suicide TAG & ROUTINE fileds in 601.71
N TEMP,CNT,TEST,YSFDA,INSTIEN,XXX,TAG,YSERR
K YSFDA
S TEMP=""
F CNT=1:1:9 D
. S TEMP=$T(INSTF+CNT)
. S TEMP=$P(TEMP,";;",2)
. S TEST=$P(TEMP,U,1) D
. S INSTIEN="" S INSTIEN=$O(^YTT(601.71,"B",TEST,""))
. S XXX=INSTIEN_","
. S YSFDA(601.71,XXX,95)="YTQRQAD6"
. S TAG=$P(TEMP,U,2)
. I TAG="zzzzz" Q
. S YSFDA(601.71,XXX,96)=TAG
D FILE^DIE("K","YSFDA","YSERR")
I $G(YSERR)'="" W !,"ERROR= ",YSERR
Q
;
INSTF ;Staff Entry Only Instruments
;;BHS^BHS
;;BSS^BSS
;;C-SSRS^CSSRS
;;I9+C-SSRS^I9CSSRS
;;PHQ9^PHQ9
;;PHQ-2+I9^PHQ2I9
;;PSS-3^PSS3
;;PSS-3 2ND^PSS32ND
;;PC-PTSD-5+I9^PTSD5I9
;;zzzzz
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS158PST 859 printed Sep 23, 2025@19:48:30 Page 2
YS158PST ;BAH/QSB - Patch 158 Post-Init ; 7/29/2020
+1 ;;5.01;MENTAL HEALTH;**158**;;Build 38
+2 ;
+3 QUIT
POST ; Post-init for YS*5.01*158
+1 DO SSRRTN
+2 QUIT
+3 ;
SSRRTN ; Set the Suicide TAG & ROUTINE fileds in 601.71
+1 NEW TEMP,CNT,TEST,YSFDA,INSTIEN,XXX,TAG,YSERR
+2 KILL YSFDA
+3 SET TEMP=""
+4 FOR CNT=1:1:9
Begin DoDot:1
+5 SET TEMP=$TEXT(INSTF+CNT)
+6 SET TEMP=$PIECE(TEMP,";;",2)
+7 SET TEST=$PIECE(TEMP,U,1)
Begin DoDot:2
End DoDot:2
+8 SET INSTIEN=""
SET INSTIEN=$ORDER(^YTT(601.71,"B",TEST,""))
+9 SET XXX=INSTIEN_","
+10 SET YSFDA(601.71,XXX,95)="YTQRQAD6"
+11 SET TAG=$PIECE(TEMP,U,2)
+12 IF TAG="zzzzz"
QUIT
+13 SET YSFDA(601.71,XXX,96)=TAG
End DoDot:1
+14 DO FILE^DIE("K","YSFDA","YSERR")
+15 IF $GET(YSERR)'=""
WRITE !,"ERROR= ",YSERR
+16 QUIT
+17 ;
INSTF ;Staff Entry Only Instruments
+1 ;;BHS^BHS
+2 ;;BSS^BSS
+3 ;;C-SSRS^CSSRS
+4 ;;I9+C-SSRS^I9CSSRS
+5 ;;PHQ9^PHQ9
+6 ;;PHQ-2+I9^PHQ2I9
+7 ;;PSS-3^PSS3
+8 ;;PSS-3 2ND^PSS32ND
+9 ;;PC-PTSD-5+I9^PTSD5I9
+10 ;;zzzzz
+11 ;
+12 QUIT
