YS158PST.m

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 ---YS158PST   859     printed  Apr 23, 2025@18:26:52                                                                                                                                                                                                     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