- DGPTODI1 ;ALB/AS - DRG INDEX REPORT ; 20 MAY 87 09:00
- ;;5.3;Registration;;Aug 13, 1993
- S IOP="HOME" D ^%ZIS K IOP D LO^DGUTL,Q,ASK G:DGQ Q
- S DGPGM="^DGPTODI2",DGVAR="DUZ^DGD^DGB^DGR^DGP^DGS^DGC1^DGC2^DGSD^DGED^DGC"
- W !!?12,*7,"** NOTE: 132 columns required for output",! D ZIS^DGUTQ G:POP Q U IO S X=132 X ^%ZOSF("RM") D ^DGPTODI2,CLOSE^DGUTQ G Q
- RD S X="" R X:DTIME I X["^"!('$T) S DGQ=1 Q
- S X=$E(X) Q
- ASK S DGQ="" W !!,"For (A)CTIVE ADMISSIONS or",!?4,"(D)ISCHARGED PATIENTS: DISCHARGED// " S Z="^ACTIVE ADMISSIONS^DISCHARGED PATIENTS" D RD Q:DGQ I X="" S X="D" W X
- D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM:",!?12,"A - Active admissions (all current inpatients) or",!?12,"D - Discharged patients within a date range",! S %="" G ASK
- S DGD=$S(X="D":1,1:0) I 'DGD S DGSD=0,DGED=(DT_.9),DGB=1,DGS=0 G R
- DC W ! S %DT="AEXP",%DT(0)=-DT,%DT("A")="Start with DISCHARGE DATE: " D ^%DT S:X["^" DGQ=1 Q:DGQ G:Y<0 DC S DGSD=Y-.1
- S %DT("A")=" End with DISCHARGE DATE: ",%DT(0)=DGSD D ^%DT S:X["^" DGQ=1 Q:DGQ G:Y<0 DC I (DGSD+10000)<Y W !,*7,?12,"Please limit your discharge date range to no more than 1 year" G DC
- S DGED=Y_.9
- B W !!,"For (T)RANSFER DRGs or",!?4,"(D)RG from 701/702/703 TRANSACTIONS: TRANSFER DRGs// " S Z="^TRANSFER DRGs^DRGs from 701/702/703 TRANSACTIONS" D RD Q:DGQ I X="" S X="T" W X
- D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM:",!?12,"D - to include DRGs calculated using diagnosis codes from",!?16,"701/702/703 transactions",!?12,"T - to include TRANSFER DRGs based on diagnosis codes from",!?16,"501 transactions",! S %="" G B
- S DGB=$S(X="T":1,1:0)
- S W !!,"Choose PTF Status(es) to include:",!?4,"(A)LL STATUSES or",!?4,"(O)PEN,(C)LOSED,(R)ELEASED,(T)RANSMITTED ONLY: ALL// "
- S Z="^ALL STATUSES^OPEN^CLOSED^RELEASED^TRANSMITTED" D RD Q:DGQ I X="" S X="A" W X
- D IN^DGHELP I %=-1 D H^DGPTODI4 G S
- S DGS=$S(X="A":"A",X="O":0,X="C":1,X="R":2,1:3)
- R W !!,"(R)ANGE or (E)XACT MATCH or (A)LL DRGs: ALL// " S Z="^RANGE^EXACT MATCH^ALL" D RD Q:DGQ I X="" S X="A" W X
- D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM:",!?12,"R - to specify a range of DRGs or",!?12,"A - to select ALL DRGs or",!?12,"E - to specify a DRG to match exactly",! S %="" G R
- S DGR=$S(X="E":0,1:1)
- I X="A" S DGR=2,(DGC1,DGC2)="" G P
- S DIC(0)="AMEZQ",DIC="^ICD(" D E^DGPTODI4:'DGR,RANGE^DGPTODI4:DGR=1 Q:DGQ
- P W !!,"Sort by (P)ATIENT NAME or (T)ERMINAL DIGIT ORDER: PATIENT// " S Z="^PATIENT NAME^TERMINAL DIGIT ORDER" D RD Q:DGQ I X="" S X="P" W X
- D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM:",!?12,"T - to sort by terminal digit order or",!?12,"P - to sort by patient last name",! S %="" G P
- S DGP=$S(X="P":1,1:0)
- C W !!,"Choose (I)NCLUDE or (S)UPPRESS NO CODES LISTING: INCLUDE// " S Z="^INCLUDE NO CODES LISTING^SUPPRESS NO CODES LISTING" D RD Q:DGQ I X="" S X="I" W X
- D IN^DGHELP I %=-1 D C^DGPTODI4 G C
- S DGC=$S(X="I":1,1:0)
- W !!,"You have selected output for: ",!?4,$S(DGD:"Patients discharged between ",1:"Active admissions.")
- I DGD S Y=(DGSD+.1) X ^DD("DD") W ?4,Y," and " S Y=$P(DGED,".") X ^DD("DD") W Y,!?4,$S('DGB:"not ",1:""),"including TRANSFER DRGs with ",$S(DGS="A":"All",DGS=0:"Open",DGS=1:"Closed",DGS=2:"Released",1:"Transmitted")," PTF status"
- W:DGD $S(DGS="A":"es",1:" only"),"." W !?4,"Search for ",$S(DGR=2:"all DRG codes",1:"DRG code: ") W DGC1 W:DGR=1 " to DRG code: ",DGC2 W "."
- W !?4,"No Codes Listing ",$S(DGC:"included",1:"suppressed"),"."
- W !?4,"Sort report by ",$S(DGP:"patient last name.",1:"terminal digit order."),!
- OK W "IS THIS CORRECT" S %=1 D YN^DICN I '% W !!?6,"Enter <RET> if this information is correct",!?10,"Enter 'N' for NO to exit",!! G OK
- S:%'=1 DGQ=1 Q
- Q K DGD,DGB,DGR,DGC,DGP,DGS,DGC1,DGC2,DGSD,DGED,DGQ,DGPGM,DGVAR,X,Y,Z,DIC,POP,%DT,% Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTODI1 3725 printed Jan 18, 2025@03:53:48 Page 2
- DGPTODI1 ;ALB/AS - DRG INDEX REPORT ; 20 MAY 87 09:00
- +1 ;;5.3;Registration;;Aug 13, 1993
- +2 SET IOP="HOME"
- DO ^%ZIS
- KILL IOP
- DO LO^DGUTL
- DO Q
- DO ASK
- if DGQ
- GOTO Q
- +3 SET DGPGM="^DGPTODI2"
- SET DGVAR="DUZ^DGD^DGB^DGR^DGP^DGS^DGC1^DGC2^DGSD^DGED^DGC"
- +4 WRITE !!?12,*7,"** NOTE: 132 columns required for output",!
- DO ZIS^DGUTQ
- if POP
- GOTO Q
- USE IO
- SET X=132
- XECUTE ^%ZOSF("RM")
- DO ^DGPTODI2
- DO CLOSE^DGUTQ
- GOTO Q
- RD SET X=""
- READ X:DTIME
- IF X["^"!('$TEST)
- SET DGQ=1
- QUIT
- +1 SET X=$EXTRACT(X)
- QUIT
- ASK SET DGQ=""
- WRITE !!,"For (A)CTIVE ADMISSIONS or",!?4,"(D)ISCHARGED PATIENTS: DISCHARGED// "
- SET Z="^ACTIVE ADMISSIONS^DISCHARGED PATIENTS"
- DO RD
- if DGQ
- QUIT
- IF X=""
- SET X="D"
- WRITE X
- +1 DO IN^DGHELP
- IF %=-1
- WRITE !!?12,"CHOOSE FROM:",!?12,"A - Active admissions (all current inpatients) or",!?12,"D - Discharged patients within a date range",!
- SET %=""
- GOTO ASK
- +2 SET DGD=$SELECT(X="D":1,1:0)
- IF 'DGD
- SET DGSD=0
- SET DGED=(DT_.9)
- SET DGB=1
- SET DGS=0
- GOTO R
- DC WRITE !
- SET %DT="AEXP"
- SET %DT(0)=-DT
- SET %DT("A")="Start with DISCHARGE DATE: "
- DO ^%DT
- if X["^"
- SET DGQ=1
- if DGQ
- QUIT
- if Y<0
- GOTO DC
- SET DGSD=Y-.1
- +1 SET %DT("A")=" End with DISCHARGE DATE: "
- SET %DT(0)=DGSD
- DO ^%DT
- if X["^"
- SET DGQ=1
- if DGQ
- QUIT
- if Y<0
- GOTO DC
- IF (DGSD+10000)<Y
- WRITE !,*7,?12,"Please limit your discharge date range to no more than 1 year"
- GOTO DC
- +2 SET DGED=Y_.9
- B WRITE !!,"For (T)RANSFER DRGs or",!?4,"(D)RG from 701/702/703 TRANSACTIONS: TRANSFER DRGs// "
- SET Z="^TRANSFER DRGs^DRGs from 701/702/703 TRANSACTIONS"
- DO RD
- if DGQ
- QUIT
- IF X=""
- SET X="T"
- WRITE X
- +1 DO IN^DGHELP
- IF %=-1
- WRITE !!?12,"CHOOSE FROM:",!?12,"D - to include DRGs calculated using diagnosis codes from",!?16,"701/702/703 transactions",!?12,"T - to include TRANSFER DRGs based on diagnosis codes from",!?16,"501 transactions",!
- SET %=""
- GOTO B
- +2 SET DGB=$SELECT(X="T":1,1:0)
- S WRITE !!,"Choose PTF Status(es) to include:",!?4,"(A)LL STATUSES or",!?4,"(O)PEN,(C)LOSED,(R)ELEASED,(T)RANSMITTED ONLY: ALL// "
- +1 SET Z="^ALL STATUSES^OPEN^CLOSED^RELEASED^TRANSMITTED"
- DO RD
- if DGQ
- QUIT
- IF X=""
- SET X="A"
- WRITE X
- +2 DO IN^DGHELP
- IF %=-1
- DO H^DGPTODI4
- GOTO S
- +3 SET DGS=$SELECT(X="A":"A",X="O":0,X="C":1,X="R":2,1:3)
- R WRITE !!,"(R)ANGE or (E)XACT MATCH or (A)LL DRGs: ALL// "
- SET Z="^RANGE^EXACT MATCH^ALL"
- DO RD
- if DGQ
- QUIT
- IF X=""
- SET X="A"
- WRITE X
- +1 DO IN^DGHELP
- IF %=-1
- WRITE !!?12,"CHOOSE FROM:",!?12,"R - to specify a range of DRGs or",!?12,"A - to select ALL DRGs or",!?12,"E - to specify a DRG to match exactly",!
- SET %=""
- GOTO R
- +2 SET DGR=$SELECT(X="E":0,1:1)
- +3 IF X="A"
- SET DGR=2
- SET (DGC1,DGC2)=""
- GOTO P
- +4 SET DIC(0)="AMEZQ"
- SET DIC="^ICD("
- if 'DGR
- DO E^DGPTODI4
- if DGR=1
- DO RANGE^DGPTODI4
- if DGQ
- QUIT
- P WRITE !!,"Sort by (P)ATIENT NAME or (T)ERMINAL DIGIT ORDER: PATIENT// "
- SET Z="^PATIENT NAME^TERMINAL DIGIT ORDER"
- DO RD
- if DGQ
- QUIT
- IF X=""
- SET X="P"
- WRITE X
- +1 DO IN^DGHELP
- IF %=-1
- WRITE !!?12,"CHOOSE FROM:",!?12,"T - to sort by terminal digit order or",!?12,"P - to sort by patient last name",!
- SET %=""
- GOTO P
- +2 SET DGP=$SELECT(X="P":1,1:0)
- C WRITE !!,"Choose (I)NCLUDE or (S)UPPRESS NO CODES LISTING: INCLUDE// "
- SET Z="^INCLUDE NO CODES LISTING^SUPPRESS NO CODES LISTING"
- DO RD
- if DGQ
- QUIT
- IF X=""
- SET X="I"
- WRITE X
- +1 DO IN^DGHELP
- IF %=-1
- DO C^DGPTODI4
- GOTO C
- +2 SET DGC=$SELECT(X="I":1,1:0)
- +3 WRITE !!,"You have selected output for: ",!?4,$SELECT(DGD:"Patients discharged between ",1:"Active admissions.")
- +4 IF DGD
- SET Y=(DGSD+.1)
- XECUTE ^DD("DD")
- WRITE ?4,Y," and "
- SET Y=$PIECE(DGED,".")
- XECUTE ^DD("DD")
- WRITE Y,!?4,$SELECT('DGB:"not ",1:""),"including TRANSFER DRGs with ",$SELECT(DGS="A":"All",DGS=0:"Open",DGS=1:"Closed",DGS=2:"Released",1:"Transmitted")," PTF status"
- +5 if DGD
- WRITE $SELECT(DGS="A":"es",1:" only"),"."
- WRITE !?4,"Search for ",$SELECT(DGR=2:"all DRG codes",1:"DRG code: ")
- WRITE DGC1
- if DGR=1
- WRITE " to DRG code: ",DGC2
- WRITE "."
- +6 WRITE !?4,"No Codes Listing ",$SELECT(DGC:"included",1:"suppressed"),"."
- +7 WRITE !?4,"Sort report by ",$SELECT(DGP:"patient last name.",1:"terminal digit order."),!
- OK WRITE "IS THIS CORRECT"
- SET %=1
- DO YN^DICN
- IF '%
- WRITE !!?6,"Enter <RET> if this information is correct",!?10,"Enter 'N' for NO to exit",!!
- GOTO OK
- +1 if %'=1
- SET DGQ=1
- QUIT
- Q KILL DGD,DGB,DGR,DGC,DGP,DGS,DGC1,DGC2,DGSD,DGED,DGQ,DGPGM,DGVAR,X,Y,Z,DIC,POP,%DT,%
- QUIT