- YS141PS0 ;SLC/KCM - Patch 141 Post-Init Update Categories ; 1/27/2020
- ;;5.01;MENTAL HEALTH;**130,141**;Dec 30, 1994;Build 85
- ;
- ; External Reference ICR#
- ; ------------------ -----
- ; %ZOSV 10097
- ; DIE 2053
- ; DIK 10013
- ; DILF 2054
- ; XPDUTL 10141
- ;
- Q
- SHOCATS ; List out categories for inclusion in routine
- N TEST,X,CAT,IEN,LIST
- S TEST=0 F S TEST=$O(^YTT(601.71,TEST)) Q:'TEST D
- . I $P($G(^YTT(601.71,TEST,2)),U,2)'="Y" QUIT ; active instrument?
- . S X="",CAT=0 F S CAT=$O(^YTT(601.71,TEST,10,CAT)) Q:'CAT D
- . . S IEN=+^YTT(601.71,TEST,10,CAT,0)
- . . S X=X_$S($L(X):U,1:"")_$P(^YTT(601.97,IEN,0),U)
- . I $L(X) S LIST($P(^YTT(601.71,TEST,0),U))=X
- S X="" F S X=$O(LIST(X)) Q:'$L(X) W !," ;;"_X_U_LIST(X)
- Q
- SETCATS ; Set categories from CATLST into 601.71
- ; Don't run this install in the dev environment
- N Y D GETENV^%ZOSV I $P(Y,U,4)="SPPNXT:VISTA" Q
- ;
- N YSI,YSJ,YSX,YSNM,YSIEN,YSCATS,YSCAT,YSCNT
- S YSCNT=0
- F YSI=1:1 S YSX=$P($T(CATLST+YSI),";;",2,99) Q:YSX="zzzzz" D
- . S YSNM=$P(YSX,U,1),YSCATS=$P(YSX,U,2,99)
- . S YSIEN=$O(^YTT(601.71,"B",YSNM,0)) Q:'YSIEN
- . D DELCATS(YSIEN)
- . N FDA,FDAIEN,DIERR
- . F YSJ=1:1:$L(YSCATS,U) D
- . . S YSCAT=$P(YSCATS,U,YSJ) Q:'$L(YSCAT)
- . . S YSCNT=YSCNT+1
- . . S FDA(601.71101,"+"_YSJ_","_YSIEN_",",.01)=YSCAT
- . Q:$D(FDA)<10
- . D UPDATE^DIE("E","FDA","FDAIEN")
- . I $D(DIERR) D MES^XPDUTL(YSNM_": "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
- . D CLEAN^DILF
- D MES^XPDUTL("Instrument categories updated: "_YSCNT)
- Q
- DELCATS(YSIEN) ; Delete the categories for instrument YSIEN
- I '$O(^YTT(601.71,YSIEN,10,0)) Q ; no child nodes
- N DA,DIK
- S DA=0,DA(1)=YSIEN,DIK="^YTT(601.71,"_DA(1)_",10,"
- F S DA=$O(^YTT(601.71,YSIEN,10,DA)) Q:'DA D ^DIK
- Q
- CATLST ; Instrument Categories
- ;;ACE^Screening
- ;;AD8^Pain^Cognitive
- ;;BSL-23^General Symptoms
- ;;BSS^Suicide Prevention
- ;;CMQ^Sleep
- ;;EAT-26^Screening
- ;;ERS^Employment
- ;;FOCI^Anxiety/PTSD
- ;;KATZ-ADL-18PT^ADL/Func Status
- ;;MHRM-10^Recovery
- ;;SCL9R^General Symptoms
- ;;zzzzz
- ;;SIP-AD-START^Sleep
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS141PS0 2154 printed Jan 18, 2025@03:13:26 Page 2
- YS141PS0 ;SLC/KCM - Patch 141 Post-Init Update Categories ; 1/27/2020
- +1 ;;5.01;MENTAL HEALTH;**130,141**;Dec 30, 1994;Build 85
- +2 ;
- +3 ; External Reference ICR#
- +4 ; ------------------ -----
- +5 ; %ZOSV 10097
- +6 ; DIE 2053
- +7 ; DIK 10013
- +8 ; DILF 2054
- +9 ; XPDUTL 10141
- +10 ;
- +11 QUIT
- SHOCATS ; List out categories for inclusion in routine
- +1 NEW TEST,X,CAT,IEN,LIST
- +2 SET TEST=0
- FOR
- SET TEST=$ORDER(^YTT(601.71,TEST))
- if 'TEST
- QUIT
- Begin DoDot:1
- +3 ; active instrument?
- IF $PIECE($GET(^YTT(601.71,TEST,2)),U,2)'="Y"
- QUIT
- +4 SET X=""
- SET CAT=0
- FOR
- SET CAT=$ORDER(^YTT(601.71,TEST,10,CAT))
- if 'CAT
- QUIT
- Begin DoDot:2
- +5 SET IEN=+^YTT(601.71,TEST,10,CAT,0)
- +6 SET X=X_$SELECT($LENGTH(X):U,1:"")_$PIECE(^YTT(601.97,IEN,0),U)
- End DoDot:2
- +7 IF $LENGTH(X)
- SET LIST($PIECE(^YTT(601.71,TEST,0),U))=X
- End DoDot:1
- +8 SET X=""
- FOR
- SET X=$ORDER(LIST(X))
- if '$LENGTH(X)
- QUIT
- WRITE !," ;;"_X_U_LIST(X)
- +9 QUIT
- SETCATS ; Set categories from CATLST into 601.71
- +1 ; Don't run this install in the dev environment
- +2 NEW Y
- DO GETENV^%ZOSV
- IF $PIECE(Y,U,4)="SPPNXT:VISTA"
- QUIT
- +3 ;
- +4 NEW YSI,YSJ,YSX,YSNM,YSIEN,YSCATS,YSCAT,YSCNT
- +5 SET YSCNT=0
- +6 FOR YSI=1:1
- SET YSX=$PIECE($TEXT(CATLST+YSI),";;",2,99)
- if YSX="zzzzz"
- QUIT
- Begin DoDot:1
- +7 SET YSNM=$PIECE(YSX,U,1)
- SET YSCATS=$PIECE(YSX,U,2,99)
- +8 SET YSIEN=$ORDER(^YTT(601.71,"B",YSNM,0))
- if 'YSIEN
- QUIT
- +9 DO DELCATS(YSIEN)
- +10 NEW FDA,FDAIEN,DIERR
- +11 FOR YSJ=1:1:$LENGTH(YSCATS,U)
- Begin DoDot:2
- +12 SET YSCAT=$PIECE(YSCATS,U,YSJ)
- if '$LENGTH(YSCAT)
- QUIT
- +13 SET YSCNT=YSCNT+1
- +14 SET FDA(601.71101,"+"_YSJ_","_YSIEN_",",.01)=YSCAT
- End DoDot:2
- +15 if $DATA(FDA)<10
- QUIT
- +16 DO UPDATE^DIE("E","FDA","FDAIEN")
- +17 IF $DATA(DIERR)
- DO MES^XPDUTL(YSNM_": "_$GET(^TMP("DIERR",$JOB,1,"TEXT",1)))
- +18 DO CLEAN^DILF
- End DoDot:1
- +19 DO MES^XPDUTL("Instrument categories updated: "_YSCNT)
- +20 QUIT
- DELCATS(YSIEN) ; Delete the categories for instrument YSIEN
- +1 ; no child nodes
- IF '$ORDER(^YTT(601.71,YSIEN,10,0))
- QUIT
- +2 NEW DA,DIK
- +3 SET DA=0
- SET DA(1)=YSIEN
- SET DIK="^YTT(601.71,"_DA(1)_",10,"
- +4 FOR
- SET DA=$ORDER(^YTT(601.71,YSIEN,10,DA))
- if 'DA
- QUIT
- DO ^DIK
- +5 QUIT
- CATLST ; Instrument Categories
- +1 ;;ACE^Screening
- +2 ;;AD8^Pain^Cognitive
- +3 ;;BSL-23^General Symptoms
- +4 ;;BSS^Suicide Prevention
- +5 ;;CMQ^Sleep
- +6 ;;EAT-26^Screening
- +7 ;;ERS^Employment
- +8 ;;FOCI^Anxiety/PTSD
- +9 ;;KATZ-ADL-18PT^ADL/Func Status
- +10 ;;MHRM-10^Recovery
- +11 ;;SCL9R^General Symptoms
- +12 ;;zzzzz
- +13 ;;SIP-AD-START^Sleep