- YSDX3U ;SLC/DJP/LJA - Utilities for Diagnoses Entered in MH Med Record ;13 May 2013 12:43 PM
- ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
- ;D RECORD^YSDX0001("^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- ;
- END K YSDXDAT D END^YSDX3U00 ;->
- QUIT
- ;
- LIST ; Called by routines YSDX3, YSDX3A, YSDX3U
- ; List diagnoses on file for a specific patient
- ;D RECORD^YSDX0001("LIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- K YSDXN,YSDXNN,YSDXST,YSMOD,YSDXDT,YSNO S N1=0
- I '$O(^YSD(627.8,"AC",YSDFN,0)) D QUIT ;->
- . W !?10,"No diagnoses on file for ",YSNM S YSNO=1
- ;
- AXIS1 ; DSM display
- ;D RECORD^YSDX0001("AXIS1^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- I YSAX=1 D
- . S L2=0
- . F S L2=$O(^YSD(627.8,"AC",YSDFN,L2)) Q:'L2 D
- . . S L3=""
- . . F S L3=$O(^YSD(627.8,"AC",YSDFN,L2,L3)) Q:L3="" I $P(L3,";",2)["YSD" D SELECTL
- AXIS3 ; ICD9/ICD10 Display
- ;D RECORD^YSDX0001("AXIS3^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- I YSAX=3 D
- . S L2=0
- . F S L2=$O(^YSD(627.8,"AC",YSDFN,L2)) Q:'L2 D
- . . S L3=""
- . . F S L3=$O(^YSD(627.8,"AC",YSDFN,L2,L3)) Q:L3="" I $P(L3,";",2)["ICD" D SELECTL
- QUIT
- ;
- SELECTL ;
- ;D RECORD^YSDX0001("SELECTL^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- S L4=""
- F S L4=$O(^YSD(627.8,"AC",YSDFN,L2,L3,L4)) Q:L4="" D
- . S L5=0
- . F S L5=$O(^YSD(627.8,"AC",YSDFN,L2,L3,L4,L5)) Q:'L5 D STATUS,ALST:YSDTY="A",ILST:YSDTY="I",IRNLST:YSDTY="IRN"
- QUIT
- STATUS ;
- ;D RECORD^YSDX0001("STATUS^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- S L9=$P(^YSD(627.8,L5,1),U,2)
- S:L9="i" F1=1
- S:"rn"[L9!($P(^YSD(627.8,L5,1),U,4)="I") F2=1
- QUIT
- ;
- ALST ;
- ;D RECORD^YSDX0001("ALST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- D:L4="A" PLIST
- QUIT
- ;
- ILST ;
- ;D RECORD^YSDX0001("ILST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- D:L9="i" PLIST
- QUIT
- ;
- IRNLST ;
- ;D RECORD^YSDX0001("IRNLST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- D:L4="I" PLIST
- QUIT
- ;
- PLIST ;Sets variables for print of list line
- ;
- ; Axis 1
- ;D RECORD^YSDX0001("PLIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- S YSDXCSTX=""
- I YSAX=1 D
- . S P3=$P(L3,";",2)
- . S P4=$P(L3,";")
- . S P5="^"_P3_P4_","_0_")"
- . S P50=@P5
- . S YSDXN=^YSD(627.7,+P4,"D") ; Diagnosis name
- . S YSDXNN=$P(P50,U) ; ICD#
- . S YSDXCSTX="(ICD-"_$S($P(P50,U,8)'="":$P(P50,U,8),1:"9")_")"
- ;
- ; Axis 3
- I YSAX=3 D
- . S P3=$P(L3,";",2)
- . S P4=$P(L3,";")
- . S P5="^"_P3_P4_","_0_")"
- . S P50=@P5
- . N YSDXDATA S YSDXDATA=$$ICDDATA^ICDXCODE("DIAG",P4,$P(^YSD(627.8,L5,0),U,3),"I")
- . S YSDXNN=$P(YSDXDATA,U,2) ; Diagnosis name
- . S YSDXCSTX=$P($P($$SINFO^ICDEX($P(YSDXDATA,U,20)),U,2),"-",2)
- . S YSDXCSTX="(ICD-"_YSDXCSTX_")"
- . S YSDXN=$P(YSDXDATA,U,4) ; ICD#
- ;
- S YSDXST=$S(L9="v":"VERIFIED",L9="p":"PROVISIONAL",L9="i":"INACTIVE",L9="r":"REFORMULATED",L9="n":"NOT FOUND",L9="ru":"RULE OUT",1:"")
- S Y=$P(^YSD(627.8,L5,0),U,3) D DD^%DT S YSDXDT=Y
- ;
- ; Modifiers
- I $D(^YSD(627.8,L5,5)) D
- . S L7=$P(^YSD(627.8,L5,5,0),U,3)
- . F I=1:1:L7 S YSMOD(I)=$P(^YSD(627.8,L5,5,I,0),U,3)
- ;
- ; DXLS?
- S L10=$P($G(^YSD(627.8,L5,1)),U,6) I L10]"" D
- . S YSDXSTAT="INACTIVATED",Y=$P(^YSD(627.8,L5,1),U,5) D DD^%DT S YSTATDT=Y
- ;
- S N1=N1+1,N2(N1)=$P(L3,";"),N4=0 K YSSTOP
- F N3=1:1 S:P4=N2(N3) N4=N4+1 S:N4>1 YSSTOP=1 Q:N3=N1
- QUIT:$D(YSSTOP) ;->
- S P1=P1+1 S P2(P1)=L5
- PRINT ;
- ;D RECORD^YSDX0001("PRINT^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- Q:YSDTY="IRN"&(L9="i") ;->
- W !,P1,?3,YSDXCSTX," ",YSDXNN,!?3,$E(YSDXN,1,75)
- I $D(YSMOD) F I=1:1:L7 I $D(YSMOD(I)) W:$TR(YSMOD(I)," ","")]"" !?8," --- "_YSMOD(I)
- W !?8," --- "_YSDXST,?35,YSDXDT I $D(YSDXSTAT) W !?8," --- "_YSDXSTAT,?35,YSTATDT
- QUIT
- ;
- INQ ; Called by routines YSDX3, YSDX3A
- ;D RECORD^YSDX0001("INQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- Q:$D(YSNO) ;->
- K %
- S F3=$S(YSAX=1:" Axes 1 & 2 ",YSAX=3:" Axis 3 ",1:"")
- I $D(F1) W !!,"List INACTIVE diagnoses" S %=2 D YN^DICN K:%=2 F1 S:%=1 YSDTY="I" I %=0 W !!,"YES will list all INACTIVE,",F3,"diagnoses for ",$E(YSNM,1,20),".",! G INQ
- S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) Q:YSTOUT!YSUOUT
- I $D(%) I %=-1 Q
- I $D(F2) D RNQ I YSTOUT!YSUOUT Q
- I $D(F1)!$D(F2) D LIST^YSDX3U I '$D(YSDXN) W !,"No additional",F3,"dx found."
- QUIT
- ;
- RNQ ;
- ;D RECORD^YSDX0001("RNQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- S %=0
- F Q:$G(%) W !!,"List REFORMULATED/NOT FOUND diagnoses" S %=2 D
- . D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) W !
- . I '% D
- . . W !!,"YES will list, in addition to all INACTIVE"
- . . W F3,"diagnoses,",!?3," all REFORMULATED/NOT FOUND"
- . . W F3,"diagnoses on file",!?3,"for ",$E(YSNM,1,20),".",!
- I %=2 K F2 QUIT ;->
- S:%=1 YSDTY="IRN"
- I %=-1 S YSQT=1
- QUIT
- ;
- EOR ;YSDX3U - Utilities for Diagnoses in MH Med Record ;6/30/89 09:49
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDX3U 4998 printed Feb 18, 2025@23:40:37 Page 2
- YSDX3U ;SLC/DJP/LJA - Utilities for Diagnoses Entered in MH Med Record ;13 May 2013 12:43 PM
- +1 ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
- +2 ;D RECORD^YSDX0001("^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +3 ;
- END ;->
- KILL YSDXDAT
- DO END^YSDX3U00
- +1 QUIT
- +2 ;
- LIST ; Called by routines YSDX3, YSDX3A, YSDX3U
- +1 ; List diagnoses on file for a specific patient
- +2 ;D RECORD^YSDX0001("LIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +3 KILL YSDXN,YSDXNN,YSDXST,YSMOD,YSDXDT,YSNO
- SET N1=0
- +4 ;->
- IF '$ORDER(^YSD(627.8,"AC",YSDFN,0))
- Begin DoDot:1
- +5 WRITE !?10,"No diagnoses on file for ",YSNM
- SET YSNO=1
- End DoDot:1
- QUIT
- +6 ;
- AXIS1 ; DSM display
- +1 ;D RECORD^YSDX0001("AXIS1^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 IF YSAX=1
- Begin DoDot:1
- +3 SET L2=0
- +4 FOR
- SET L2=$ORDER(^YSD(627.8,"AC",YSDFN,L2))
- if 'L2
- QUIT
- Begin DoDot:2
- +5 SET L3=""
- +6 FOR
- SET L3=$ORDER(^YSD(627.8,"AC",YSDFN,L2,L3))
- if L3=""
- QUIT
- IF $PIECE(L3,";",2)["YSD"
- DO SELECTL
- End DoDot:2
- End DoDot:1
- AXIS3 ; ICD9/ICD10 Display
- +1 ;D RECORD^YSDX0001("AXIS3^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 IF YSAX=3
- Begin DoDot:1
- +3 SET L2=0
- +4 FOR
- SET L2=$ORDER(^YSD(627.8,"AC",YSDFN,L2))
- if 'L2
- QUIT
- Begin DoDot:2
- +5 SET L3=""
- +6 FOR
- SET L3=$ORDER(^YSD(627.8,"AC",YSDFN,L2,L3))
- if L3=""
- QUIT
- IF $PIECE(L3,";",2)["ICD"
- DO SELECTL
- End DoDot:2
- End DoDot:1
- +7 QUIT
- +8 ;
- SELECTL ;
- +1 ;D RECORD^YSDX0001("SELECTL^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 SET L4=""
- +3 FOR
- SET L4=$ORDER(^YSD(627.8,"AC",YSDFN,L2,L3,L4))
- if L4=""
- QUIT
- Begin DoDot:1
- +4 SET L5=0
- +5 FOR
- SET L5=$ORDER(^YSD(627.8,"AC",YSDFN,L2,L3,L4,L5))
- if 'L5
- QUIT
- DO STATUS
- if YSDTY="A"
- DO ALST
- if YSDTY="I"
- DO ILST
- if YSDTY="IRN"
- DO IRNLST
- End DoDot:1
- +6 QUIT
- STATUS ;
- +1 ;D RECORD^YSDX0001("STATUS^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 SET L9=$PIECE(^YSD(627.8,L5,1),U,2)
- +3 if L9="i"
- SET F1=1
- +4 if "rn"[L9!($PIECE(^YSD(627.8,L5,1),U,4)="I")
- SET F2=1
- +5 QUIT
- +6 ;
- ALST ;
- +1 ;D RECORD^YSDX0001("ALST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 if L4="A"
- DO PLIST
- +3 QUIT
- +4 ;
- ILST ;
- +1 ;D RECORD^YSDX0001("ILST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 if L9="i"
- DO PLIST
- +3 QUIT
- +4 ;
- IRNLST ;
- +1 ;D RECORD^YSDX0001("IRNLST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 if L4="I"
- DO PLIST
- +3 QUIT
- +4 ;
- PLIST ;Sets variables for print of list line
- +1 ;
- +2 ; Axis 1
- +3 ;D RECORD^YSDX0001("PLIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +4 SET YSDXCSTX=""
- +5 IF YSAX=1
- Begin DoDot:1
- +6 SET P3=$PIECE(L3,";",2)
- +7 SET P4=$PIECE(L3,";")
- +8 SET P5="^"_P3_P4_","_0_")"
- +9 SET P50=@P5
- +10 ; Diagnosis name
- SET YSDXN=^YSD(627.7,+P4,"D")
- +11 ; ICD#
- SET YSDXNN=$PIECE(P50,U)
- +12 SET YSDXCSTX="(ICD-"_$SELECT($PIECE(P50,U,8)'="":$PIECE(P50,U,8),1:"9")_")"
- End DoDot:1
- +13 ;
- +14 ; Axis 3
- +15 IF YSAX=3
- Begin DoDot:1
- +16 SET P3=$PIECE(L3,";",2)
- +17 SET P4=$PIECE(L3,";")
- +18 SET P5="^"_P3_P4_","_0_")"
- +19 SET P50=@P5
- +20 NEW YSDXDATA
- SET YSDXDATA=$$ICDDATA^ICDXCODE("DIAG",P4,$PIECE(^YSD(627.8,L5,0),U,3),"I")
- +21 ; Diagnosis name
- SET YSDXNN=$PIECE(YSDXDATA,U,2)
- +22 SET YSDXCSTX=$PIECE($PIECE($$SINFO^ICDEX($PIECE(YSDXDATA,U,20)),U,2),"-",2)
- +23 SET YSDXCSTX="(ICD-"_YSDXCSTX_")"
- +24 ; ICD#
- SET YSDXN=$PIECE(YSDXDATA,U,4)
- End DoDot:1
- +25 ;
- +26 SET YSDXST=$SELECT(L9="v":"VERIFIED",L9="p":"PROVISIONAL",L9="i":"INACTIVE",L9="r":"REFORMULATED",L9="n":"NOT FOUND",L9="ru":"RULE OUT",1:"")
- +27 SET Y=$PIECE(^YSD(627.8,L5,0),U,3)
- DO DD^%DT
- SET YSDXDT=Y
- +28 ;
- +29 ; Modifiers
- +30 IF $DATA(^YSD(627.8,L5,5))
- Begin DoDot:1
- +31 SET L7=$PIECE(^YSD(627.8,L5,5,0),U,3)
- +32 FOR I=1:1:L7
- SET YSMOD(I)=$PIECE(^YSD(627.8,L5,5,I,0),U,3)
- End DoDot:1
- +33 ;
- +34 ; DXLS?
- +35 SET L10=$PIECE($GET(^YSD(627.8,L5,1)),U,6)
- IF L10]""
- Begin DoDot:1
- +36 SET YSDXSTAT="INACTIVATED"
- SET Y=$PIECE(^YSD(627.8,L5,1),U,5)
- DO DD^%DT
- SET YSTATDT=Y
- End DoDot:1
- +37 ;
- +38 SET N1=N1+1
- SET N2(N1)=$PIECE(L3,";")
- SET N4=0
- KILL YSSTOP
- +39 FOR N3=1:1
- if P4=N2(N3)
- SET N4=N4+1
- if N4>1
- SET YSSTOP=1
- if N3=N1
- QUIT
- +40 ;->
- if $DATA(YSSTOP)
- QUIT
- +41 SET P1=P1+1
- SET P2(P1)=L5
- PRINT ;
- +1 ;D RECORD^YSDX0001("PRINT^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 ;->
- if YSDTY="IRN"&(L9="i")
- QUIT
- +3 WRITE !,P1,?3,YSDXCSTX," ",YSDXNN,!?3,$EXTRACT(YSDXN,1,75)
- +4 IF $DATA(YSMOD)
- FOR I=1:1:L7
- IF $DATA(YSMOD(I))
- if $TRANSLATE(YSMOD(I)," ","")]""
- WRITE !?8," --- "_YSMOD(I)
- +5 WRITE !?8," --- "_YSDXST,?35,YSDXDT
- IF $DATA(YSDXSTAT)
- WRITE !?8," --- "_YSDXSTAT,?35,YSTATDT
- +6 QUIT
- +7 ;
- INQ ; Called by routines YSDX3, YSDX3A
- +1 ;D RECORD^YSDX0001("INQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 ;->
- if $DATA(YSNO)
- QUIT
- +3 KILL %
- +4 SET F3=$SELECT(YSAX=1:" Axes 1 & 2 ",YSAX=3:" Axis 3 ",1:"")
- +5 IF $DATA(F1)
- WRITE !!,"List INACTIVE diagnoses"
- SET %=2
- DO YN^DICN
- if %=2
- KILL F1
- if %=1
- SET YSDTY="I"
- IF %=0
- WRITE !!,"YES will list all INACTIVE,",F3,"diagnoses for ",$EXTRACT(YSNM,1,20),".",!
- GOTO INQ
- +6 SET YSTOUT=$DATA(DTOUT)
- SET YSUOUT=$DATA(DUOUT)
- if YSTOUT!YSUOUT
- QUIT
- +7 IF $DATA(%)
- IF %=-1
- QUIT
- +8 IF $DATA(F2)
- DO RNQ
- IF YSTOUT!YSUOUT
- QUIT
- +9 IF $DATA(F1)!$DATA(F2)
- DO LIST^YSDX3U
- IF '$DATA(YSDXN)
- WRITE !,"No additional",F3,"dx found."
- +10 QUIT
- +11 ;
- RNQ ;
- +1 ;D RECORD^YSDX0001("RNQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
- +2 SET %=0
- +3 FOR
- if $GET(%)
- QUIT
- WRITE !!,"List REFORMULATED/NOT FOUND diagnoses"
- SET %=2
- Begin DoDot:1
- +4 DO YN^DICN
- SET YSTOUT=$DATA(DTOUT)
- SET YSUOUT=$DATA(DUOUT)
- WRITE !
- +5 IF '%
- Begin DoDot:2
- +6 WRITE !!,"YES will list, in addition to all INACTIVE"
- +7 WRITE F3,"diagnoses,",!?3," all REFORMULATED/NOT FOUND"
- +8 WRITE F3,"diagnoses on file",!?3,"for ",$EXTRACT(YSNM,1,20),".",!
- End DoDot:2
- End DoDot:1
- +9 ;->
- IF %=2
- KILL F2
- QUIT
- +10 if %=1
- SET YSDTY="IRN"
- +11 IF %=-1
- SET YSQT=1
- +12 QUIT
- +13 ;
- EOR ;YSDX3U - Utilities for Diagnoses in MH Med Record ;6/30/89 09:49