Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTEXPR

DGPTEXPR.m

Go to the documentation of this file. 
  1. DGPTEXPR ;ALB/MTC - PTF Expanded Code List ;14 MAY 91
  1.  ;;5.3;Registration;**850**;Aug 13, 1993;Build 171
  1.  ;;MAS 5.1;
  1.  ;
  1. EN ; -- entry point for Expanded Code List (ICD-10 Remediation)
  1.  N CAT,CODE
  1.  D INIT G:DGOUT ENQ
  1.  W @IOF,!,"PTF Expanded Code List   "
  1.  ;
  1.  S PG=1,L="",DIC="^DIC(45.89,"
  1.  ;
  1.  D CODESET G:CODESET<1 ENQ
  1.  ;
  1.  S CAT("START")=$$STARTCAT(CODESET)
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!(CAT("START")="") G ENQ
  1.  ;
  1.  S CAT("FINISH")=$$FINALCAT(CODESET,CAT("START"))
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!(CAT("FINISH")="") G ENQ
  1.  ;
  1.  S CODE("START")=$$STARTCOD(CODESET)
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!(CODE("START")="") G ENQ
  1.  ;
  1.  S CODE("FINISH")=$$FINALCOD(CODESET,CODE("START"))
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!(CODE("FINISH")="") G ENQ
  1.  ;
  1.  S:CAT("START")="FIRST" CAT("START")=""
  1.  S:CAT("FINISH")="LAST" CAT("FINISH")=""
  1.  S:CODE("START")="FIRST" CODE("START")=""
  1.  S:CODE("FINISH")="LAST" CODE("FINISH")=""
  1.  ;
  1.  I CODESET=9 D
  1.  . S FLDS="[DGPT EXPANDED CODE LIST]"
  1.  . S BY="[DGPT EXPANDED CODE SORT ICD-9]"
  1.  . S FR="ICD-10-CM,"_CAT("START")_","_CODE("START")
  1.  . S TO="ICD-10-PCS,"_CAT("FINISH")_","_CODE("FINISH")
  1.  ;
  1.  I CODESET=10 D
  1.  . S FLDS="[DGPT EXPANDED CODE LIST-10]"
  1.  . S BY="[DGPT EXPANDED CODE SORT ICD-10]"
  1.  . S FR="ICD-9 PROC,"_CAT("START")_","_CODE("START")
  1.  . S TO="ICD-9-CM,"_CAT("FINISH")_","_CODE("FINISH")
  1.  ;
  1.  D EN1^DIP
  1.  ; 
  1. ENQ ; -- exit point
  1.  K X,Y,L,DIC,FLDS,BY,FR,PG,FROM,TO,DTOUT,DUOUT,DIRUT,DIROUT,LIST,VERSION,CODESET,DGOUT,DGQUIT,CAT,CODE
  1.  Q
  1. STARTCAT(CSET) ; -- Start Code Set
  1.  N X,Y,VAL,DIR
  1.  S VAL=""
  1.  S DIR("?",1)="Answer with PTF EXPANDED CODE CATEGORY NAME"
  1.  S DIR("?")="   Select FIRST to select all CATEGORY names"
  1.  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"
  1.  S DIR("A")="START WITH CATEGORY: "
  1.  S DIR("B")="FIRST"
  1.  S DIR(0)="SAO^"_LIST
  1.  D ^DIR
  1.  S VAL=$G(Y(0))
  1.  Q VAL
  1.  ;
  1. FINALCAT(CSET,STRT) ; -- Start Code Set
  1.  N X,Y,VAL,DIR
  1.  I STRT="FIRST" Q "LAST"
  1.  S VAL=""
  1. FC ; - Re-ask
  1.  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"
  1.  S DIR("?",1)="Answer with PTF EXPANDED CODE CATEGORY NAME"
  1.  S DIR("?")="   Select LAST to select all CATEGORY names after "_STRT
  1.  S DIR("A")="GO TO CATEGORY: "
  1.  S DIR("B")="LAST"
  1.  S DIR(0)="SAO^"_LIST
  1.  D ^DIR
  1.  S VAL=$G(Y(0))
  1.  I VAL'="LAST",(VAL'=STRT),(VAL']STRT) W !,"Go To value must equal or follow the Start With value",*7,! G FC
  1.  Q VAL
  1.  ;
  1. STARTCOD(CSET) ; -- Start Code Set
  1.  N VAL,D,DIC,DIR,DGX1,DGX2,REASK,VP
  1.  S VAL=""
  1. R1 ;
  1.  R !,"   START WITH DIAGNOSIS/PROCEDURE CODE: FIRST// ",Y:DTIME S:'$T Y="^",DTOUT=""
  1.  I Y="?" D HELP1 G R1
  1.  I Y["??" D HELP1,LIST(CSET,.CAT) G R1
  1.  I Y="" S Y="FIRST"
  1.  ;
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q "-1"
  1.  I $G(Y)="FIRST" Q Y
  1.  ;
  1.  S X=$G(Y)
  1. SC ; Re-ask
  1.  S DIC("A")="   START WITH DIAGNOSIS/PROCEDURE CODE: "
  1.  S DIC="^DIC(45.89,"
  1.  S DIC(0)=$S($G(REASK):"AEQZ",1:"EQZ")
  1.  S DGX1=$S(CSET=9:1,1:30)
  1.  S DGX2=$S(CSET=9:2,1:31)
  1.  S DIC("S")="I $P(^(0),U,5)="_DGX1_"!($P(^(0),U,5)="_DGX2_")"
  1.  S D="ACODE"
  1.  D IX^DIC
  1.  I $D(DTOUT)!($D(DUOUT)) Q ""
  1.  I Y<1 K X S REASK=1 G SC
  1.  S VP=$P($G(^DIC(45.89,+Y,0)),U,2)
  1.  S VAL=$$CODEC^ICDEX($S(VP["ICD9":80,VP["ICD0":80.1,1:80),+VP)
  1.  Q VAL
  1.  ;
  1. FINALCOD(CSET,STRT) ; -- Start Code Set
  1.  N VAL,D,DIC,DIR,DGX1,DGX2,REASK,VP
  1.  I STRT="FIRST" Q "LAST"
  1.  S VAL=""
  1.  ;
  1. R2 ;
  1.  R !,"   GO TO DIAGNOSIS/PROCEDURE CODE: LAST// ",Y:DTIME S:'$T Y="^",DTOUT=""
  1.  I Y="?" D HELP1 G R2
  1.  I Y["??" D HELP1,LIST(CSET,.CAT) G R2
  1.  I Y="" S Y="LAST"
  1.  ;
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q "-1"
  1.  I $G(Y)="LAST" Q Y
  1.  ;
  1.  S X=$G(Y)
  1. FCCC ; Re-ask
  1.  S DIC("A")="   GO TO DIAGNOSIS/PROCEDURE CODE: "
  1.  S DIC="^DIC(45.89,"
  1.  S DIC(0)=$S($G(REASK):"AEQZ",1:"EQZ")
  1.  S DGX1=$S(CSET=9:1,1:30)
  1.  S DGX2=$S(CSET=9:2,1:31)
  1.  S DIC("S")="I $P(^(0),U,5)="_DGX1_"!($P(^(0),U,5)="_DGX2_")"
  1.  S D="ACODE"
  1.  D IX^DIC
  1.  I $D(DTOUT)!($D(DUOUT)) Q ""
  1.  I Y<1 K X S REASK=1 G FCCC
  1.  S VP=$P($G(^DIC(45.89,+Y,0)),U,2)
  1.  S VAL=$$CODEC^ICDEX($S(VP["ICD9":80,VP["ICD0":80.1,1:80),+VP)
  1.  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
  1.  Q VAL
  1.  ;
  1. INIT ;
  1.  S DGOUT=0
  1.  D LO^DGUTL,HOME^%ZIS
  1.  Q
  1.  ;
  1. CODESET ; -ask which codeset
  1.  ;Select ICD Code Set (9,10):
  1.  N DIR,X,Y,IMPDATE,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S IMPDATE=$P($$IMPDATE^DGPTIC10("10D"),U,1)
  1.  ;
  1.  S DIR(0)="SA^9:ICD-9;10:ICD-10"
  1.  S DIR("A")="Select ICD Code Set (9,10): "
  1.  S DIR("B")=$S(DT<IMPDATE:9,1:10)
  1.  S DIR("L")=""
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S Y=-1
  1.  S CODESET=Y
  1.  Q
  1.  ;
  1. HELP1 ; -- Code help text
  1.  W !!,"TO  IN SEQUENCE, STARTING FROM A CERTAIN DIAGNOSIS/PROCEDURE CODE, "
  1.  W !,"     TYPE THAT DIAGNOSIS/PROCEDURE CODE"
  1.  W !,"     OR ENTER '@' TO INCLUDE NULL DIAGNOSIS/PROCEDURE CODE VALUES"
  1.  W !,"    OR ENTER 'FIRST' TO START FROM THE FIRST VALUE"
  1.  Q
  1.  ;
  1. LIST(CSET,CAT) ; -- List available codes
  1.  N I,J,ZZ,ENTRY,IEN,VESION,CNT,DGQUIT,STRT,FNSH,IENCAT,OK
  1.  W !,"   Choose from:",!
  1.  S ENTRY="",CNT=1
  1.  S STRT=$G(CAT("START")),FNSH=$G(CAT("FINISH"))
  1.  I STRT="FIRST" S STRT="A"
  1.  I FNSH="LAST" S FNSH="ZZZ"
  1.  F I=0:0 S ENTRY=$O(^DIC(45.89,"ACODE",ENTRY)) Q:ENTRY=""!($D(DGQUIT))  D
  1.  . S IEN=0
  1.  . F J=0:0 S IEN=$O(^DIC(45.89,"ACODE",ENTRY,IEN)) Q:IEN=""!($D(DGQUIT))  D
  1.  .. S IENCAT=$P($G(^DIC(45.88,+$P($G(^DIC(45.89,IEN,0)),U,1),0)),U,1)
  1.  .. S VERSION=$P($G(^DIC(45.89,IEN,0)),U,5)
  1.  .. S OK=0 I (IENCAT=STRT)!(IENCAT=FNSH) S OK=1
  1.  .. I 'OK&((IENCAT']STRT)!(IENCAT]FNSH)) Q
  1.  .. ;
  1.  .. I CSET=9 I (VERSION=1)!(VERSION=2) W ?3,ENTRY,?15,IENCAT,! S CNT=CNT+1
  1.  .. I CSET=10 I (VERSION=30)!(VERSION=31) W ?3,ENTRY,?15,IENCAT,! S CNT=CNT+1
  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)
  1.  .. Q
  1.  Q