DVBADSRT.m

DVBADSRT ;ALB/GTS-557/THM-AMIE DISCHARGE RPT ; 1/16/91  4:23 PM

 ;;2.7;AMIE;**17,59**;Apr 10, 1995

 ;

 K ^TMP($J) G TERM

 ;

SET Q:'$D(^DPT(DA,0))  S DFN=DA,DVBASC="" D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)  Q:ADTYPE="S"&(DVBASC'="Y")  Q:ADTYPE="A"&(RCVAA'=1)  Q:ADTYPE="P"&(RCVPEN'="1")

 S TDIS=$S($D(^DGPM(+MB,0)):$P(^(0),U,18),1:"")

 I $D(^DG(405.2,+TDIS,0)) DO

 .;I '$D(^TMP("DVBA",$J,"DUP",+TDIS)) Q

 .I '$D(DISTYPE(+TDIS)) Q

 .S TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type")

 .S ^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM_U_TDIS

 .Q

 Q

 ;

PRINTB S MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),TDIS=$P(DATA,U,5),DFN=DA,QUIT1=1 D DCHGDT^DVBAVDPT

 W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF

 W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!

 W ?10,"Patient Name:",?26,PNAM,!!,?14,"Claim No:",?26,CNUM,!,?6,"Claim Folder Loc:",?26,CFLOC,!,?9,"Social Sec No:",?26,SSN,!

 W ?8,"Discharge Date:",?26,$$FMTE^XLFDT(DCHGDT,"5DZ"),!,?5,"Type of Discharge:",?26,TDIS,!

 D LOS^DVBAUTIL W ?8,"Length of Stay:",?26,LOS_$S(LOS="":"Discharged same day",LOS=1:" day",1:" days"),!

 W ?11,"Bed Service:",?26,BEDSEC,!

 W ?13,"Recv A&A?:",?26,$S(RCVAA="0":"NO",RCVAA="1":"YES",1:"Not specified"),!

 W ?14,"Pension?:",?26,$S(RCVPEN="0":"NO",RCVPEN="1":"YES",1:"Not specified"),! D ELIG^DVBAVDPT

 I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop    " R ANS:DTIME S:ANS=U!('$T) QUIT=1 I ANS=U S DVBAQUIT=1

 S DVBAON2=""

 Q

 ;

PRINT U IO S QUIT=""

 S XCN="" F M=0:0 S XCN=$O(^TMP($J,XCN)) Q:XCN=""!(QUIT=1)  S CFLOC="" F J=0:0 S CFLOC=$O(^TMP($J,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1)  D PRINT1

 Q

PRINT1 S ADM="" F K=0:0 S ADM=$O(^TMP($J,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1)  S DA="" F L=0:0 S DA=$O(^TMP($J,XCN,CFLOC,ADM,DA)) Q:DA=""!(QUIT=1)  S DATA=^(DA) D PRINTB

 Q

 ;

TERM D HOME^%ZIS K NOASK

 ;

SETUP W @IOF,!,"VARO DISCHARGE REPORT" D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")

 S DSRP=1,HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) W !,HEAD1

 ;

EN1 W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,4) X ^DD("DD") W Y,!!

 D DATE^DVBAUTIL

 G:X=""!(Y<0) KILL

 ;

ADTYPE D ADTYPE^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL

 W @IOF

 K DVBACEPT

 D EN^VALM("DVBA DISCHARGE TYPES")

 I '$D(DVBACEPT) D KILL^DVBAUTIL Q

 I '$O(^TMP("DVBA",$J,"DUP",0)) D KILL^DVBAUTIL Q

 M DISTYPE=^TMP("DVBA",$J,"DUP")

 ;

 W !!! S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL

 ;

QUEUE ;I $D(IO("Q")) S ZTRTN="DEQUE^DVBADSRT",ZTIO=ION,NOASK=1,ZTDESC="AMIE DISCHARGE REPORT" F I="^TMP(""DVBA"",$J,""DUP""","ADTYPE","DVBATYPS","BDATE","BDATE1","EDATE","FDT(0)","HEAD","HEAD1","HD","RO","RONUM","NOASK" S ZTSAVE(I)=""

 I $D(IO("Q")) S ZTRTN="DEQUE^DVBADSRT",ZTIO=ION,NOASK=1,ZTDESC="AMIE DICHARGE REPORT" F I="DISTYPE(","ADTYPE","DVBATYPS","BDATE","BDATE1","EDATE","FDT(0)","HEAD","HEAD1","HD","RO","RONUM","NOASK" S ZTSAVE(I)=""

 I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",! G KILL

 ;

GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV3",MA)) Q:MA>EDATE!(MA="")  W:'$D(NOASK) "." F DA=0:0 S DA=$O(^DGPM("AMV3",MA,DA)) Q:DA=""  F MB=0:0 S MB=$O(^DGPM("AMV3",MA,DA,MB)) Q:MB=""  D SET

 I '$D(^TMP($J)) U IO W !!,*7,"No data found for parameters entered.",!! H 2 G KILL

 D PRINT I $D(DVBAQUIT) K DVBAON2,DISTYPE G KILL^DVBAUTIL

 W !!,"End of the Report"

 ;

KILL D ^%ZISC D:$D(ZTQUEUED) KILL^%ZTLOAD S X=4 K DVBAON2,DISTYPE G FINAL^DVBAUTIL

 ;

DEQUE K ^TMP($J) G GO

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBADSRT   3604     printed  Feb 18, 2025@23:07:32                                                                                                                                                                                                    Page 2

DVBADSRT  ;ALB/GTS-557/THM-AMIE DISCHARGE RPT ; 1/16/91  4:23 PM

 +1       ;;2.7;AMIE;**17,59**;Apr 10, 1995

 +2       ;

 +3        KILL ^TMP($JOB)

           GOTO TERM

 +4       ;

SET        if '$DATA(^DPT(DA,0))

               QUIT 

           SET DFN=DA

           SET DVBASC=""

           DO RCV^DVBAVDPT

           if CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)

               QUIT 

           if ADTYPE="S"&(DVBASC'="Y")

               QUIT 

           if ADTYPE="A"&(RCVAA'=1)

               QUIT 

           if ADTYPE="P"&(RCVPEN'="1")

               QUIT 

 +1        SET TDIS=$SELECT($DATA(^DGPM(+MB,0)):$PIECE(^(0),U,18),1:"")

 +2        IF $DATA(^DG(405.2,+TDIS,0))

               Begin DoDot:1

 +3       ;I '$D(^TMP("DVBA",$J,"DUP",+TDIS)) Q

 +4                IF '$DATA(DISTYPE(+TDIS))

                       QUIT 

 +5                SET TDIS=$SELECT($PIECE(^DG(405.2,+TDIS,0),U,1)]"":$PIECE(^(0),U,1),1:"Unknown discharge type")

 +6                SET ^TMP($JOB,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM_U_TDIS

 +7                QUIT 

               End DoDot:1

 +8        QUIT 

 +9       ;

PRINTB     SET MA=$PIECE(DATA,U)

           SET RCVAA=$PIECE(DATA,U,2)

           SET RCVPEN=$PIECE(DATA,U,3)

           SET CNUM=$PIECE(DATA,U,4)

           SET TDIS=$PIECE(DATA,U,5)

           SET DFN=DA

           SET QUIT1=1

           DO DCHGDT^DVBAVDPT

 +1        if (IOST?1"C-".E)!($DATA(DVBAON2))

               WRITE @IOF

 +2        WRITE !!!,?(80-$LENGTH(HEAD)\2),HEAD,!,?(80-$LENGTH(HEAD1)\2),HEAD1,!!

 +3        WRITE ?10,"Patient Name:",?26,PNAM,!!,?14,"Claim No:",?26,CNUM,!,?6,"Claim Folder Loc:",?26,CFLOC,!,?9,"Social Sec No:",?26,SSN,!

 +4        WRITE ?8,"Discharge Date:",?26,$$FMTE^XLFDT(DCHGDT,"5DZ"),!,?5,"Type of Discharge:",?26,TDIS,!

 +5        DO LOS^DVBAUTIL

           WRITE ?8,"Length of Stay:",?26,LOS_$SELECT(LOS="":"Discharged same day",LOS=1:" day",1:" days"),!

 +6        WRITE ?11,"Bed Service:",?26,BEDSEC,!

 +7        WRITE ?13,"Recv A&A?:",?26,$SELECT(RCVAA="0":"NO",RCVAA="1":"YES",1:"Not specified"),!

 +8        WRITE ?14,"Pension?:",?26,$SELECT(RCVPEN="0":"NO",RCVPEN="1":"YES",1:"Not specified"),!

           DO ELIG^DVBAVDPT

 +9        IF IOST?1"C-".E

               WRITE *7,!,"Press RETURN to continue or ""^"" to stop    "

               READ ANS:DTIME

               if ANS=U!('$TEST)

                   SET QUIT=1

               IF ANS=U

                   SET DVBAQUIT=1

 +10       SET DVBAON2=""

 +11       QUIT 

 +12      ;

PRINT      USE IO

           SET QUIT=""

 +1        SET XCN=""

           FOR M=0:0

               SET XCN=$ORDER(^TMP($JOB,XCN))

               if XCN=""!(QUIT=1)

                   QUIT 

               SET CFLOC=""

               FOR J=0:0

                   SET CFLOC=$ORDER(^TMP($JOB,XCN,CFLOC))

                   if CFLOC=""!(QUIT=1)

                       QUIT 

                   DO PRINT1

 +2        QUIT 

PRINT1     SET ADM=""

           FOR K=0:0

               SET ADM=$ORDER(^TMP($JOB,XCN,CFLOC,ADM))

               if ADM=""!(QUIT=1)

                   QUIT 

               SET DA=""

               FOR L=0:0

                   SET DA=$ORDER(^TMP($JOB,XCN,CFLOC,ADM,DA))

                   if DA=""!(QUIT=1)

                       QUIT 

                   SET DATA=^(DA)

                   DO PRINTB

 +1        QUIT 

 +2       ;

TERM       DO HOME^%ZIS

           KILL NOASK

 +1       ;

SETUP      WRITE @IOF,!,"VARO DISCHARGE REPORT"

           DO NOPARM^DVBAUTL2

           if $DATA(DVBAQUIT)

               GOTO KILL^DVBAUTIL

           SET DTAR=^DVB(396.1,1,0)

           SET FDT(0)=$$FMTE^XLFDT(DT,"5DZ")

 +1        SET DSRP=1

           SET HEAD1="FOR "_$PIECE(DTAR,U,1)_" ON "_FDT(0)

           WRITE !,HEAD1

 +2       ;

EN1        WRITE !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on "

           SET Y=$PIECE(DTAR,U,4)

           XECUTE ^DD("DD")

           WRITE Y,!!

 +1        DO DATE^DVBAUTIL

 +2        if X=""!(Y<0)

               GOTO KILL

 +3       ;

ADTYPE     DO ADTYPE^DVBAUTL2

           if $DATA(DVBAQUIT)

               GOTO KILL^DVBAUTIL

 +1        WRITE @IOF

 +2        KILL DVBACEPT

 +3        DO EN^VALM("DVBA DISCHARGE TYPES")

 +4        IF '$DATA(DVBACEPT)

               DO KILL^DVBAUTIL

               QUIT 

 +5        IF '$ORDER(^TMP("DVBA",$JOB,"DUP",0))

               DO KILL^DVBAUTIL

               QUIT 

 +6        MERGE DISTYPE=^TMP("DVBA",$JOB,"DUP")

 +7       ;

 +8        WRITE !!!

           SET %ZIS="Q"

           DO ^%ZIS

           KILL %ZIS

           if POP

               GOTO KILL^DVBAUTIL

 +9       ;

QUEUE     ;I $D(IO("Q")) S ZTRTN="DEQUE^DVBADSRT",ZTIO=ION,NOASK=1,ZTDESC="AMIE DISCHARGE REPORT" F I="^TMP(""DVBA"",$J,""DUP""","ADTYPE","DVBATYPS","BDATE","BDATE1","EDATE","FDT(0)","HEAD","HEAD1","HD","RO","RONUM","NOASK" S ZTSAVE(I)=""

 +1        IF $DATA(IO("Q"))

               SET ZTRTN="DEQUE^DVBADSRT"

               SET ZTIO=ION

               SET NOASK=1

               SET ZTDESC="AMIE DICHARGE REPORT"

               FOR I="DISTYPE(","ADTYPE","DVBATYPS","BDATE","BDATE1","EDATE","FDT(0)","HEAD","HEAD1","HD","RO","RONUM","NOASK"

                   SET ZTSAVE(I)=""

 +2        IF $DATA(IO("Q"))

               DO ^%ZTLOAD

               if $DATA(ZTSK)

                   WRITE !!,"Request queued.",!

               GOTO KILL

 +3       ;

GO         SET MA=BDATE

           FOR J=0:0

               SET MA=$ORDER(^DGPM("AMV3",MA))

               if MA>EDATE!(MA="")

                   QUIT 

               if '$DATA(NOASK)

                   WRITE "."

               FOR DA=0:0

                   SET DA=$ORDER(^DGPM("AMV3",MA,DA))

                   if DA=""

                       QUIT 

                   FOR MB=0:0

                       SET MB=$ORDER(^DGPM("AMV3",MA,DA,MB))

                       if MB=""

                           QUIT 

                       DO SET

 +1        IF '$DATA(^TMP($JOB))

               USE IO

               WRITE !!,*7,"No data found for parameters entered.",!!

               HANG 2

               GOTO KILL

 +2        DO PRINT

           IF $DATA(DVBAQUIT)

               KILL DVBAON2,DISTYPE

               GOTO KILL^DVBAUTIL

 +3        WRITE !!,"End of the Report"

 +4       ;

KILL       DO ^%ZISC

           if $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

           SET X=4

           KILL DVBAON2,DISTYPE

           GOTO FINAL^DVBAUTIL

 +1       ;

DEQUE      KILL ^TMP($JOB)

           GOTO GO