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 Sep 23, 2025@20:29 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
