- YSDX3R ;SLC/DJP - Print of Diagnosis for the Mental Health Medical Record ;12/13/93 16:02
- ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
- ;
- ; Called from the top by MENU option YSDIAGP-DX
- ;D RECORD^YSDX0001("YSDX3R^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- ;
- ENTRY ;
- ;D RECORD^YSDX0001("ENTRY^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- W @IOF W !!?IOM-$L("PRINT OF DIAGNOSIS")\2,"PRINT OF DIAGNOSIS",!!
- D ^YSLRP I YSTOUT!YSUOUT!(YSDFN'>0) G END
- I '$D(^YSD(627.8,"AC",YSDFN)) W !!?10,"No diagnosis on file for ",YSNM G END
- QUES1 ;
- W !!,"SORT BY (D)IAGNOSIS or (C)HRONOLOGICALLY? D// " R A:DTIME S YSTOUT='$T,YSUOUT=A["^" I YSTOUT!YSUOUT G END
- S A=$E(A) S:A="" A="D" I A["?" W !!,"You may list diagnoses sequentially or by date.",!! G QUES1
- I "DdCc"'[A W " ?",! G QUES1
- QUES2 ;
- ;D RECORD^YSDX0001("QUES2^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- S %=0 F Q:$G(%) W !,"LIST ONLY ACTIVE DIAGNOSIS" S %=1 D
- .D YN^DICN I '% W !!,"You may list only active diagnoses or both active and inactive diagnoses.",!
- S:%=2 YSTY="ALL" I %=-1 G END
- S:'$D(YSTY) YSTY="ACT"
- DEVICE ;
- ;D RECORD^YSDX0001("DEVICE^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- K IOP S %ZIS="Q" D ^%ZIS I POP G END
- I $D(IO("Q")) S ZTRTN="ENPR^YSDX3R",(ZTSAVE("A"),ZTSAVE("YS*"))="",ZTDESC="YS DX PT" D ^%ZTLOAD G END
- ENPR ;Entry to core of print program.
- ;D RECORD^YSDX0001("ENPR^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- S YSFHDR="DIAGNOSIS LIST",YSFHDR(1)="W !!,""DSM/ICD TITLE"" X YSFHDR(2),YSFHDR(3)",YSFHDR(2)="I YSTY=""ACT"" W ?25,""**** Only Active Diagnosis ****""",YSFHDR(3)="W !,""STATUS"",?10,""DATE""" S YSPP=0
- PR ; Called from YSDX3RU
- ;D RECORD^YSDX0001("PR^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- U IO D:'$D(YSNOFORM) ENHD^YSFORM S Y1=0,YST=$S(IOST?1"P".E:1,1:0),YSSL=$S(YST:8,1:3),YSLFT=0
- D DXLS^YSDX3RUA G:YSTOUT!YSUOUT END D DX^YSDX3RU:"Dd"[A,CHR^YSDX3RU:"Cc"[A I YSTOUT!YSUOUT G END
- D AX4^YSDX3RUA G:YSTOUT!YSUOUT END D AX5^YSDX3RUA
- S YSCON=0 D:'$D(YSFFS) FINISH^YSDX3RU
- END ;
- ;D RECORD^YSDX0001("END^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- I $G(ZTSK) S ZTREQ="@"
- D KVAR^VADPT,^%ZISC
- K A,A1,A2,A3,A4,A5,A6,A7,A8,A9,G,G1,G2,G3,G4,G5,G6,G7,G8,G9
- K G10,G11,J,K,L,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,M,W,X,Y,Y1
- K YSAX4,YSD3FLG,YSDIFLG,YSDXNN,YSDXN,YSML,YSMOD,YSDXDT
- K TOTSET,SUBSET,YSDFN,YSAUTH,YSCD,YSCOND,YSDOB,YSDTM,YSDXS
- K YSFHDR,YSFTR,YSGAF,YSLC,YSLFT,YSNM,YSPP,YSPS,YSSL,YSSSN
- K YSSTOP,YST,YSTM,YSTOP1,YSTOP2,YSTY,YSAGE,YSDUZ,YSSEX,YSQT
- K Z,Z1,YSLCN,YSCON,DIWR,DIWL,DIWF,YSFFS
- QUIT
- ;
- EOR ;YSDX3R - Print Diagnosis for Medical Record ;12/6/90 11:19
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDX3R 2715 printed Jan 18, 2025@03:15:23 Page 2
- YSDX3R ;SLC/DJP - Print of Diagnosis for the Mental Health Medical Record ;12/13/93 16:02
- +1 ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
- +2 ;
- +3 ; Called from the top by MENU option YSDIAGP-DX
- +4 ;D RECORD^YSDX0001("YSDX3R^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- +5 ;
- ENTRY ;
- +1 ;D RECORD^YSDX0001("ENTRY^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- +2 WRITE @IOF
- WRITE !!?IOM-$LENGTH("PRINT OF DIAGNOSIS")\2,"PRINT OF DIAGNOSIS",!!
- +3 DO ^YSLRP
- IF YSTOUT!YSUOUT!(YSDFN'>0)
- GOTO END
- +4 IF '$DATA(^YSD(627.8,"AC",YSDFN))
- WRITE !!?10,"No diagnosis on file for ",YSNM
- GOTO END
- QUES1 ;
- +1 WRITE !!,"SORT BY (D)IAGNOSIS or (C)HRONOLOGICALLY? D// "
- READ A:DTIME
- SET YSTOUT='$TEST
- SET YSUOUT=A["^"
- IF YSTOUT!YSUOUT
- GOTO END
- +2 SET A=$EXTRACT(A)
- if A=""
- SET A="D"
- IF A["?"
- WRITE !!,"You may list diagnoses sequentially or by date.",!!
- GOTO QUES1
- +3 IF "DdCc"'[A
- WRITE " ?",!
- GOTO QUES1
- QUES2 ;
- +1 ;D RECORD^YSDX0001("QUES2^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- +2 SET %=0
- FOR
- if $GET(%)
- QUIT
- WRITE !,"LIST ONLY ACTIVE DIAGNOSIS"
- SET %=1
- Begin DoDot:1
- +3 DO YN^DICN
- IF '%
- WRITE !!,"You may list only active diagnoses or both active and inactive diagnoses.",!
- End DoDot:1
- +4 if %=2
- SET YSTY="ALL"
- IF %=-1
- GOTO END
- +5 if '$DATA(YSTY)
- SET YSTY="ACT"
- DEVICE ;
- +1 ;D RECORD^YSDX0001("DEVICE^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- +2 KILL IOP
- SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- GOTO END
- +3 IF $DATA(IO("Q"))
- SET ZTRTN="ENPR^YSDX3R"
- SET (ZTSAVE("A"),ZTSAVE("YS*"))=""
- SET ZTDESC="YS DX PT"
- DO ^%ZTLOAD
- GOTO END
- ENPR ;Entry to core of print program.
- +1 ;D RECORD^YSDX0001("ENPR^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- +2 SET YSFHDR="DIAGNOSIS LIST"
- SET YSFHDR(1)="W !!,""DSM/ICD TITLE"" X YSFHDR(2),YSFHDR(3)"
- SET YSFHDR(2)="I YSTY=""ACT"" W ?25,""**** Only Active Diagnosis ****"""
- SET YSFHDR(3)="W !,""STATUS"",?10,""DATE"""
- SET YSPP=0
- PR ; Called from YSDX3RU
- +1 ;D RECORD^YSDX0001("PR^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- +2 USE IO
- if '$DATA(YSNOFORM)
- DO ENHD^YSFORM
- SET Y1=0
- SET YST=$SELECT(IOST?1"P".E:1,1:0)
- SET YSSL=$SELECT(YST:8,1:3)
- SET YSLFT=0
- +3 DO DXLS^YSDX3RUA
- if YSTOUT!YSUOUT
- GOTO END
- if "Dd"[A
- DO DX^YSDX3RU
- if "Cc"[A
- DO CHR^YSDX3RU
- IF YSTOUT!YSUOUT
- GOTO END
- +4 DO AX4^YSDX3RUA
- if YSTOUT!YSUOUT
- GOTO END
- DO AX5^YSDX3RUA
- +5 SET YSCON=0
- if '$DATA(YSFFS)
- DO FINISH^YSDX3RU
- END ;
- +1 ;D RECORD^YSDX0001("END^YSDX3R") ;Used for testing. Inactivated in YSDX0001...
- +2 IF $GET(ZTSK)
- SET ZTREQ="@"
- +3 DO KVAR^VADPT
- DO ^%ZISC
- +4 KILL A,A1,A2,A3,A4,A5,A6,A7,A8,A9,G,G1,G2,G3,G4,G5,G6,G7,G8,G9
- +5 KILL G10,G11,J,K,L,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,M,W,X,Y,Y1
- +6 KILL YSAX4,YSD3FLG,YSDIFLG,YSDXNN,YSDXN,YSML,YSMOD,YSDXDT
- +7 KILL TOTSET,SUBSET,YSDFN,YSAUTH,YSCD,YSCOND,YSDOB,YSDTM,YSDXS
- +8 KILL YSFHDR,YSFTR,YSGAF,YSLC,YSLFT,YSNM,YSPP,YSPS,YSSL,YSSSN
- +9 KILL YSSTOP,YST,YSTM,YSTOP1,YSTOP2,YSTY,YSAGE,YSDUZ,YSSEX,YSQT
- +10 KILL Z,Z1,YSLCN,YSCON,DIWR,DIWL,DIWF,YSFFS
- +11 QUIT
- +12 ;
- EOR ;YSDX3R - Print Diagnosis for Medical Record ;12/6/90 11:19