DGPTEXPR ;ALB/MTC - PTF Expanded Code List ;14 MAY 91
;;5.3;Registration;**850**;Aug 13, 1993;Build 171
;;MAS 5.1;
;
EN ; -- entry point for Expanded Code List (ICD-10 Remediation)
N CAT,CODE
D INIT G:DGOUT ENQ
W @IOF,!,"PTF Expanded Code List "
;
S PG=1,L="",DIC="^DIC(45.89,"
;
D CODESET G:CODESET<1 ENQ
;
S CAT("START")=$$STARTCAT(CODESET)
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!(CAT("START")="") G ENQ
;
S CAT("FINISH")=$$FINALCAT(CODESET,CAT("START"))
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!(CAT("FINISH")="") G ENQ
;
S CODE("START")=$$STARTCOD(CODESET)
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!(CODE("START")="") G ENQ
;
S CODE("FINISH")=$$FINALCOD(CODESET,CODE("START"))
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!(CODE("FINISH")="") G ENQ
;
S:CAT("START")="FIRST" CAT("START")=""
S:CAT("FINISH")="LAST" CAT("FINISH")=""
S:CODE("START")="FIRST" CODE("START")=""
S:CODE("FINISH")="LAST" CODE("FINISH")=""
;
I CODESET=9 D
. S FLDS="[DGPT EXPANDED CODE LIST]"
. S BY="[DGPT EXPANDED CODE SORT ICD-9]"
. S FR="ICD-10-CM,"_CAT("START")_","_CODE("START")
. S TO="ICD-10-PCS,"_CAT("FINISH")_","_CODE("FINISH")
;
I CODESET=10 D
. S FLDS="[DGPT EXPANDED CODE LIST-10]"
. S BY="[DGPT EXPANDED CODE SORT ICD-10]"
. S FR="ICD-9 PROC,"_CAT("START")_","_CODE("START")
. S TO="ICD-9-CM,"_CAT("FINISH")_","_CODE("FINISH")
;
D EN1^DIP
;
ENQ ; -- exit point
K X,Y,L,DIC,FLDS,BY,FR,PG,FROM,TO,DTOUT,DUOUT,DIRUT,DIROUT,LIST,VERSION,CODESET,DGOUT,DGQUIT,CAT,CODE
Q
STARTCAT(CSET) ; -- Start Code Set
N X,Y,VAL,DIR
S VAL=""
S DIR("?",1)="Answer with PTF EXPANDED CODE CATEGORY NAME"
S DIR("?")=" Select FIRST to select all CATEGORY names"
S LIST="FI:FIRST;DI:DIALYSIS TYPE;KI:KIDNEY TRANSPLANT STATUS;LE:LEGIONNAIRE'S DISEASE;PS:PSYCHIATRY AXIS CLASSIFICATION;SUB:SUBSTANCE ABUSE;SUI:SUICIDE INDICATOR"
S DIR("A")="START WITH CATEGORY: "
S DIR("B")="FIRST"
S DIR(0)="SAO^"_LIST
D ^DIR
S VAL=$G(Y(0))
Q VAL
;
FINALCAT(CSET,STRT) ; -- Start Code Set
N X,Y,VAL,DIR
I STRT="FIRST" Q "LAST"
S VAL=""
FC ; - Re-ask
S LIST="LA:LAST;DI:DIALYSIS TYPE;KI:KIDNEY TRANSPLANT STATUS;LE:LEGIONNAIRE'S DISEASE;PS:PSYCHIATRY AXIS CLASSIFICATION;SUB:SUBSTANCE ABUSE;SUI:SUICIDE INDICATOR"
S DIR("?",1)="Answer with PTF EXPANDED CODE CATEGORY NAME"
S DIR("?")=" Select LAST to select all CATEGORY names after "_STRT
S DIR("A")="GO TO CATEGORY: "
S DIR("B")="LAST"
S DIR(0)="SAO^"_LIST
D ^DIR
S VAL=$G(Y(0))
I VAL'="LAST",(VAL'=STRT),(VAL']STRT) W !,"Go To value must equal or follow the Start With value",*7,! G FC
Q VAL
;
STARTCOD(CSET) ; -- Start Code Set
N VAL,D,DIC,DIR,DGX1,DGX2,REASK,VP
S VAL=""
R1 ;
R !," START WITH DIAGNOSIS/PROCEDURE CODE: FIRST// ",Y:DTIME S:'$T Y="^",DTOUT=""
I Y="?" D HELP1 G R1
I Y["??" D HELP1,LIST(CSET,.CAT) G R1
I Y="" S Y="FIRST"
;
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q "-1"
I $G(Y)="FIRST" Q Y
;
S X=$G(Y)
SC ; Re-ask
S DIC("A")=" START WITH DIAGNOSIS/PROCEDURE CODE: "
S DIC="^DIC(45.89,"
S DIC(0)=$S($G(REASK):"AEQZ",1:"EQZ")
S DGX1=$S(CSET=9:1,1:30)
S DGX2=$S(CSET=9:2,1:31)
S DIC("S")="I $P(^(0),U,5)="_DGX1_"!($P(^(0),U,5)="_DGX2_")"
S D="ACODE"
D IX^DIC
I $D(DTOUT)!($D(DUOUT)) Q ""
I Y<1 K X S REASK=1 G SC
S VP=$P($G(^DIC(45.89,+Y,0)),U,2)
S VAL=$$CODEC^ICDEX($S(VP["ICD9":80,VP["ICD0":80.1,1:80),+VP)
Q VAL
;
FINALCOD(CSET,STRT) ; -- Start Code Set
N VAL,D,DIC,DIR,DGX1,DGX2,REASK,VP
I STRT="FIRST" Q "LAST"
S VAL=""
;
R2 ;
R !," GO TO DIAGNOSIS/PROCEDURE CODE: LAST// ",Y:DTIME S:'$T Y="^",DTOUT=""
I Y="?" D HELP1 G R2
I Y["??" D HELP1,LIST(CSET,.CAT) G R2
I Y="" S Y="LAST"
;
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q "-1"
I $G(Y)="LAST" Q Y
;
S X=$G(Y)
FCCC ; Re-ask
S DIC("A")=" GO TO DIAGNOSIS/PROCEDURE CODE: "
S DIC="^DIC(45.89,"
S DIC(0)=$S($G(REASK):"AEQZ",1:"EQZ")
S DGX1=$S(CSET=9:1,1:30)
S DGX2=$S(CSET=9:2,1:31)
S DIC("S")="I $P(^(0),U,5)="_DGX1_"!($P(^(0),U,5)="_DGX2_")"
S D="ACODE"
D IX^DIC
I $D(DTOUT)!($D(DUOUT)) Q ""
I Y<1 K X S REASK=1 G FCCC
S VP=$P($G(^DIC(45.89,+Y,0)),U,2)
S VAL=$$CODEC^ICDEX($S(VP["ICD9":80,VP["ICD0":80.1,1:80),+VP)
I VAL'="LAST",(VAL'=STRT),(VAL']STRT) W !,"Go To value must equal or follow the Start With value",*7,! K X S REASK=1 G FCCC
Q VAL
;
INIT ;
S DGOUT=0
D LO^DGUTL,HOME^%ZIS
Q
;
CODESET ; -ask which codeset
;Select ICD Code Set (9,10):
N DIR,X,Y,IMPDATE,DTOUT,DUOUT,DIRUT,DIROUT
S IMPDATE=$P($$IMPDATE^DGPTIC10("10D"),U,1)
;
S DIR(0)="SA^9:ICD-9;10:ICD-10"
S DIR("A")="Select ICD Code Set (9,10): "
S DIR("B")=$S(DT<IMPDATE:9,1:10)
S DIR("L")=""
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S Y=-1
S CODESET=Y
Q
;
HELP1 ; -- Code help text
W !!,"TO IN SEQUENCE, STARTING FROM A CERTAIN DIAGNOSIS/PROCEDURE CODE, "
W !," TYPE THAT DIAGNOSIS/PROCEDURE CODE"
W !," OR ENTER '@' TO INCLUDE NULL DIAGNOSIS/PROCEDURE CODE VALUES"
W !," OR ENTER 'FIRST' TO START FROM THE FIRST VALUE"
Q
;
LIST(CSET,CAT) ; -- List available codes
N I,J,ZZ,ENTRY,IEN,VESION,CNT,DGQUIT,STRT,FNSH,IENCAT,OK
W !," Choose from:",!
S ENTRY="",CNT=1
S STRT=$G(CAT("START")),FNSH=$G(CAT("FINISH"))
I STRT="FIRST" S STRT="A"
I FNSH="LAST" S FNSH="ZZZ"
F I=0:0 S ENTRY=$O(^DIC(45.89,"ACODE",ENTRY)) Q:ENTRY=""!($D(DGQUIT)) D
. S IEN=0
. F J=0:0 S IEN=$O(^DIC(45.89,"ACODE",ENTRY,IEN)) Q:IEN=""!($D(DGQUIT)) D
.. S IENCAT=$P($G(^DIC(45.88,+$P($G(^DIC(45.89,IEN,0)),U,1),0)),U,1)
.. S VERSION=$P($G(^DIC(45.89,IEN,0)),U,5)
.. S OK=0 I (IENCAT=STRT)!(IENCAT=FNSH) S OK=1
.. I 'OK&((IENCAT']STRT)!(IENCAT]FNSH)) Q
.. ;
.. I CSET=9 I (VERSION=1)!(VERSION=2) W ?3,ENTRY,?15,IENCAT,! S CNT=CNT+1
.. I CSET=10 I (VERSION=30)!(VERSION=31) W ?3,ENTRY,?15,IENCAT,! S CNT=CNT+1
.. I '(CNT#18) R " '^' TO STOP: ",ZZ:$G(DTIME,300) S:'$T DGQUIT=1 S:ZZ["^" DGQUIT=1 W:ZZ="" $C(13),$J("",15),$C(13)
.. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTEXPR 6065 printed Apr 09, 2024@21:53:16 Page 2
DGPTEXPR ;ALB/MTC - PTF Expanded Code List ;14 MAY 91
+1 ;;5.3;Registration;**850**;Aug 13, 1993;Build 171
+2 ;;MAS 5.1;
+3 ;
EN ; -- entry point for Expanded Code List (ICD-10 Remediation)
+1 NEW CAT,CODE
+2 DO INIT
if DGOUT
GOTO ENQ
+3 WRITE @IOF,!,"PTF Expanded Code List "
+4 ;
+5 SET PG=1
SET L=""
SET DIC="^DIC(45.89,"
+6 ;
+7 DO CODESET
if CODESET<1
GOTO ENQ
+8 ;
+9 SET CAT("START")=$$STARTCAT(CODESET)
+10 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))!(CAT("START")="")
GOTO ENQ
+11 ;
+12 SET CAT("FINISH")=$$FINALCAT(CODESET,CAT("START"))
+13 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))!(CAT("FINISH")="")
GOTO ENQ
+14 ;
+15 SET CODE("START")=$$STARTCOD(CODESET)
+16 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))!(CODE("START")="")
GOTO ENQ
+17 ;
+18 SET CODE("FINISH")=$$FINALCOD(CODESET,CODE("START"))
+19 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))!(CODE("FINISH")="")
GOTO ENQ
+20 ;
+21 if CAT("START")="FIRST"
SET CAT("START")=""
+22 if CAT("FINISH")="LAST"
SET CAT("FINISH")=""
+23 if CODE("START")="FIRST"
SET CODE("START")=""
+24 if CODE("FINISH")="LAST"
SET CODE("FINISH")=""
+25 ;
+26 IF CODESET=9
Begin DoDot:1
+27 SET FLDS="[DGPT EXPANDED CODE LIST]"
+28 SET BY="[DGPT EXPANDED CODE SORT ICD-9]"
+29 SET FR="ICD-10-CM,"_CAT("START")_","_CODE("START")
+30 SET TO="ICD-10-PCS,"_CAT("FINISH")_","_CODE("FINISH")
End DoDot:1
+31 ;
+32 IF CODESET=10
Begin DoDot:1
+33 SET FLDS="[DGPT EXPANDED CODE LIST-10]"
+34 SET BY="[DGPT EXPANDED CODE SORT ICD-10]"
+35 SET FR="ICD-9 PROC,"_CAT("START")_","_CODE("START")
+36 SET TO="ICD-9-CM,"_CAT("FINISH")_","_CODE("FINISH")
End DoDot:1
+37 ;
+38 DO EN1^DIP
+39 ;
ENQ ; -- exit point
+1 KILL X,Y,L,DIC,FLDS,BY,FR,PG,FROM,TO,DTOUT,DUOUT,DIRUT,DIROUT,LIST,VERSION,CODESET,DGOUT,DGQUIT,CAT,CODE
+2 QUIT
STARTCAT(CSET) ; -- Start Code Set
+1 NEW X,Y,VAL,DIR
+2 SET VAL=""
+3 SET DIR("?",1)="Answer with PTF EXPANDED CODE CATEGORY NAME"
+4 SET DIR("?")=" Select FIRST to select all CATEGORY names"
+5 SET LIST="FI:FIRST;DI:DIALYSIS TYPE;KI:KIDNEY TRANSPLANT STATUS;LE:LEGIONNAIRE'S DISEASE;PS:PSYCHIATRY AXIS CLASSIFICATION;SUB:SUBSTANCE ABUSE;SUI:SUICIDE INDICATOR"
+6 SET DIR("A")="START WITH CATEGORY: "
+7 SET DIR("B")="FIRST"
+8 SET DIR(0)="SAO^"_LIST
+9 DO ^DIR
+10 SET VAL=$GET(Y(0))
+11 QUIT VAL
+12 ;
FINALCAT(CSET,STRT) ; -- Start Code Set
+1 NEW X,Y,VAL,DIR
+2 IF STRT="FIRST"
QUIT "LAST"
+3 SET VAL=""
FC ; - Re-ask
+1 SET LIST="LA:LAST;DI:DIALYSIS TYPE;KI:KIDNEY TRANSPLANT STATUS;LE:LEGIONNAIRE'S DISEASE;PS:PSYCHIATRY AXIS CLASSIFICATION;SUB:SUBSTANCE ABUSE;SUI:SUICIDE INDICATOR"
+2 SET DIR("?",1)="Answer with PTF EXPANDED CODE CATEGORY NAME"
+3 SET DIR("?")=" Select LAST to select all CATEGORY names after "_STRT
+4 SET DIR("A")="GO TO CATEGORY: "
+5 SET DIR("B")="LAST"
+6 SET DIR(0)="SAO^"_LIST
+7 DO ^DIR
+8 SET VAL=$GET(Y(0))
+9 IF VAL'="LAST"
IF (VAL'=STRT)
IF (VAL']STRT)
WRITE !,"Go To value must equal or follow the Start With value",*7,!
GOTO FC
+10 QUIT VAL
+11 ;
STARTCOD(CSET) ; -- Start Code Set
+1 NEW VAL,D,DIC,DIR,DGX1,DGX2,REASK,VP
+2 SET VAL=""
R1 ;
+1 READ !," START WITH DIAGNOSIS/PROCEDURE CODE: FIRST// ",Y:DTIME
if '$TEST
SET Y="^"
SET DTOUT=""
+2 IF Y="?"
DO HELP1
GOTO R1
+3 IF Y["??"
DO HELP1
DO LIST(CSET,.CAT)
GOTO R1
+4 IF Y=""
SET Y="FIRST"
+5 ;
+6 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT "-1"
+7 IF $GET(Y)="FIRST"
QUIT Y
+8 ;
+9 SET X=$GET(Y)
SC ; Re-ask
+1 SET DIC("A")=" START WITH DIAGNOSIS/PROCEDURE CODE: "
+2 SET DIC="^DIC(45.89,"
+3 SET DIC(0)=$SELECT($GET(REASK):"AEQZ",1:"EQZ")
+4 SET DGX1=$SELECT(CSET=9:1,1:30)
+5 SET DGX2=$SELECT(CSET=9:2,1:31)
+6 SET DIC("S")="I $P(^(0),U,5)="_DGX1_"!($P(^(0),U,5)="_DGX2_")"
+7 SET D="ACODE"
+8 DO IX^DIC
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT ""
+10 IF Y<1
KILL X
SET REASK=1
GOTO SC
+11 SET VP=$PIECE($GET(^DIC(45.89,+Y,0)),U,2)
+12 SET VAL=$$CODEC^ICDEX($SELECT(VP["ICD9":80,VP["ICD0":80.1,1:80),+VP)
+13 QUIT VAL
+14 ;
FINALCOD(CSET,STRT) ; -- Start Code Set
+1 NEW VAL,D,DIC,DIR,DGX1,DGX2,REASK,VP
+2 IF STRT="FIRST"
QUIT "LAST"
+3 SET VAL=""
+4 ;
R2 ;
+1 READ !," GO TO DIAGNOSIS/PROCEDURE CODE: LAST// ",Y:DTIME
if '$TEST
SET Y="^"
SET DTOUT=""
+2 IF Y="?"
DO HELP1
GOTO R2
+3 IF Y["??"
DO HELP1
DO LIST(CSET,.CAT)
GOTO R2
+4 IF Y=""
SET Y="LAST"
+5 ;
+6 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT "-1"
+7 IF $GET(Y)="LAST"
QUIT Y
+8 ;
+9 SET X=$GET(Y)
FCCC ; Re-ask
+1 SET DIC("A")=" GO TO DIAGNOSIS/PROCEDURE CODE: "
+2 SET DIC="^DIC(45.89,"
+3 SET DIC(0)=$SELECT($GET(REASK):"AEQZ",1:"EQZ")
+4 SET DGX1=$SELECT(CSET=9:1,1:30)
+5 SET DGX2=$SELECT(CSET=9:2,1:31)
+6 SET DIC("S")="I $P(^(0),U,5)="_DGX1_"!($P(^(0),U,5)="_DGX2_")"
+7 SET D="ACODE"
+8 DO IX^DIC
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT ""
+10 IF Y<1
KILL X
SET REASK=1
GOTO FCCC
+11 SET VP=$PIECE($GET(^DIC(45.89,+Y,0)),U,2)
+12 SET VAL=$$CODEC^ICDEX($SELECT(VP["ICD9":80,VP["ICD0":80.1,1:80),+VP)
+13 IF VAL'="LAST"
IF (VAL'=STRT)
IF (VAL']STRT)
WRITE !,"Go To value must equal or follow the Start With value",*7,!
KILL X
SET REASK=1
GOTO FCCC
+14 QUIT VAL
+15 ;
INIT ;
+1 SET DGOUT=0
+2 DO LO^DGUTL
DO HOME^%ZIS
+3 QUIT
+4 ;
CODESET ; -ask which codeset
+1 ;Select ICD Code Set (9,10):
+2 NEW DIR,X,Y,IMPDATE,DTOUT,DUOUT,DIRUT,DIROUT
+3 SET IMPDATE=$PIECE($$IMPDATE^DGPTIC10("10D"),U,1)
+4 ;
+5 SET DIR(0)="SA^9:ICD-9;10:ICD-10"
+6 SET DIR("A")="Select ICD Code Set (9,10): "
+7 SET DIR("B")=$SELECT(DT<IMPDATE:9,1:10)
+8 SET DIR("L")=""
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET Y=-1
+11 SET CODESET=Y
+12 QUIT
+13 ;
HELP1 ; -- Code help text
+1 WRITE !!,"TO IN SEQUENCE, STARTING FROM A CERTAIN DIAGNOSIS/PROCEDURE CODE, "
+2 WRITE !," TYPE THAT DIAGNOSIS/PROCEDURE CODE"
+3 WRITE !," OR ENTER '@' TO INCLUDE NULL DIAGNOSIS/PROCEDURE CODE VALUES"
+4 WRITE !," OR ENTER 'FIRST' TO START FROM THE FIRST VALUE"
+5 QUIT
+6 ;
LIST(CSET,CAT) ; -- List available codes
+1 NEW I,J,ZZ,ENTRY,IEN,VESION,CNT,DGQUIT,STRT,FNSH,IENCAT,OK
+2 WRITE !," Choose from:",!
+3 SET ENTRY=""
SET CNT=1
+4 SET STRT=$GET(CAT("START"))
SET FNSH=$GET(CAT("FINISH"))
+5 IF STRT="FIRST"
SET STRT="A"
+6 IF FNSH="LAST"
SET FNSH="ZZZ"
+7 FOR I=0:0
SET ENTRY=$ORDER(^DIC(45.89,"ACODE",ENTRY))
if ENTRY=""!($DATA(DGQUIT))
QUIT
Begin DoDot:1
+8 SET IEN=0
+9 FOR J=0:0
SET IEN=$ORDER(^DIC(45.89,"ACODE",ENTRY,IEN))
if IEN=""!($DATA(DGQUIT))
QUIT
Begin DoDot:2
+10 SET IENCAT=$PIECE($GET(^DIC(45.88,+$PIECE($GET(^DIC(45.89,IEN,0)),U,1),0)),U,1)
+11 SET VERSION=$PIECE($GET(^DIC(45.89,IEN,0)),U,5)
+12 SET OK=0
IF (IENCAT=STRT)!(IENCAT=FNSH)
SET OK=1
+13 IF 'OK&((IENCAT']STRT)!(IENCAT]FNSH))
QUIT
+14 ;
+15 IF CSET=9
IF (VERSION=1)!(VERSION=2)
WRITE ?3,ENTRY,?15,IENCAT,!
SET CNT=CNT+1
+16 IF CSET=10
IF (VERSION=30)!(VERSION=31)
WRITE ?3,ENTRY,?15,IENCAT,!
SET CNT=CNT+1
+17 IF '(CNT#18)
READ " '^' TO STOP: ",ZZ:$GET(DTIME,300)
if '$TEST
SET DGQUIT=1
if ZZ["^"
SET DGQUIT=1
if ZZ=""
WRITE $CHAR(13),$JUSTIFY("",15),$CHAR(13)
+18 QUIT
End DoDot:2
End DoDot:1
+19 QUIT
