DVBAB57 ;ALB/KLB - AMIE GUI PENDING 7131 REPORT ;09/7/00
;;2.7;AMIE;**35,42,185**;Apr 10, 1995;Build 18
;
STRT(MSG,SELDIV,DIV,DVBADLMTR) ;
S DVBADLMTR=$S(DVBADLMTR=1:",",1:0)
S RO="N"
S RONUM=0
S DIVNUM="",MSGCNT=1
K ^TMP($J),^TMP("CAPRI")
I RO="Y",RONUM="" S MSG(1)="To sort by RO Number, please enter the RO Number."
I RO="Y",RONUM="" Q
I SELDIV="Y",DIV="" S MSG(1)="To sort by Division, please enter the Division."
I SELDIV="Y",DIV="" Q
I DIV'="" S DIVNUM=$O(^DG(40.8,"C",DIV,DIVNUM)),DIVNAM=$S($D(^DG(40.8,+DIVNUM,0)):$P(^(0),"^",1),1:"Unknown Division")
SETUP D STM^DVBCUTL4
S FDT(0)=$$FMTE^XLFDT(DT,"5DZ"),(PG,DVBAQUIT)=0
S HEAD="PENDING REQUEST REPORT FOR "_$P(^DVB(396.1,1,0),U,1)
S HEAD2=$S(RO="Y":"FOR REGIONAL OFFICE "_RONUM,1:"ALL REGIONAL OFFICES")
S HEAD2=HEAD2_$S(SELDIV="Y":", FOR DIVISION "_DIVNAM,1:", ALL DIVISIONS")
S PROCDT="Processed on: "_FDT(0)
S QQ=1,NODTA=0
I $G(DVBADLMTR)="," D G DATA
. S ^TMP("CAPRI",$J,MSGCNT)=HEAD_$C(13),MSGCNT=MSGCNT+1,^TMP("CAPRI",$J,MSGCNT)=""""_HEAD2_""""_$C(13),MSGCNT=MSGCNT+1,^TMP("CAPRI",$J,MSGCNT)=PROCDT_$C(13)_$C(13),MSGCNT=MSGCNT+1
. S ^TMP("CAPRI",$J,MSGCNT)=$S(SELDIV="Y":"Division",SELDIV="N":"Original Division",1:"")_DVBADLMTR_"Patient Name"_DVBADLMTR_"SSN"_DVBADLMTR_"Claim no."_DVBADLMTR_"Activity/Admission Date"_DVBADLMTR_"Request Date"_DVBADLMTR
. S ^TMP("CAPRI",$J,MSGCNT)=^TMP("CAPRI",$J,MSGCNT)_"** Discharged"_DVBADLMTR_"Elapsed Days"_DVBADLMTR_"Items Pending"_DVBADLMTR_"Requested by Name"_DVBADLMTR_"Requested by Division"_$C(13),MSGCNT=MSGCNT+1
I $G(DVBADLMTR)=0 D
. S ^TMP("CAPRI",MSGCNT)="Pending 7131 Report"_"^",MSGCNT=MSGCNT+1
. S ^TMP("CAPRI",MSGCNT)=""_"^",MSGCNT=MSGCNT+1
. S ^TMP("CAPRI",MSGCNT)=HEAD_"^",MSGCNT=MSGCNT+1
. S ^TMP("CAPRI",MSGCNT)=HEAD2_"^",MSGCNT=MSGCNT+1
. S ^TMP("CAPRI",MSGCNT)=PROCDT_"^",MSGCNT=MSGCNT+1
. S ^TMP("CAPRI",MSGCNT)=""_"^",MSGCNT=MSGCNT+1
DATA N REQDTE S REQDTE="",CNT=0
S:SELDIV="Y" ADIV=DIVNAM
F J=0:0 S REQDTE=$O(^DVB(396,"E",REQDTE)) Q:REQDTE="" F DA=0:0 S DA=$O(^DVB(396,"E",REQDTE,DA)) Q:DA="" I $D(^DVB(396,DA,1)),($P(^DVB(396,DA,1),U,12)="") D:SELDIV="N" ADIV D MAKUTL
S (ADIV,REQDTE)=""
F L=0:0 S REQDTE=$O(^TMP($J,REQDTE)) Q:REQDTE="" D LVL2LP
;
EXIT I NODTA=0 S MSG(1)="No pending requests found for parameters entered."
I NODTA>0,$G(DVBADLMTR)=0 S MSG=$NA(^TMP("CAPRI"))
I NODTA>0,$G(DVBADLMTR)="," S MSG=$NA(^TMP("CAPRI",$J))
;
KILL S XRTN=$T(+0)
D SPM^DVBCUTL4
K ^TMP("DVBA","ADMIT",$J),^TMP($J),DVBAQUIT,SELDIV,DIVNUM,REQDTE,PROCDT,QQ,RO,RONUM,XRTN,CNT,MSGCNT,NODTA
K LPCNT1,PATDA,DIVNAM,XJ,XI,GDIVPTR,GDIVNUM,GINSTPT,GDIVNAM,GDIV,ADIV,CFLOC,DA,DIV,FDT,HEAD,HEAD2,J,L,PG,DVBADLMTR
Q
;
LVL2LP ; ** 2nd level of the 2nd loop in the DATA tag - search ADIV **
F J=0:0 S ADIV=$O(^TMP($J,REQDTE,ADIV)) Q:ADIV="" D LPLVL3
Q
;
LPLVL3 ; ** 2nd level of the loop in the LVL2LP tag - search DA **
F DA=0:0 S DA=$O(^TMP($J,REQDTE,ADIV,DA)) Q:DA="" D PRINT^DVBAB67 S:DVBAQUIT=1 ADIV="ZZZZ",DA=999999999,REQDTE=9999999 S QQ=1
Q
;
MAKUTL ; ** Sort on Request Date to set up a temporary utility global **
S PATDA=$P(^DVB(396,DA,0),"^",1)
;S REQDTE=$P(^DVB(396,DA,1),"^",1),PATDA=$P(^DVB(396,DA,0),"^",1)
S CFLOC=$$STATION^DVBAUTL1(PATDA)
S:CFLOC=-1 CFLOC=0
I SELDIV="Y"&(RO="Y") I CFLOC=RONUM D CHKDIV D:$D(DVBAFND) SETARY
I SELDIV="Y"&(RO="N") D CHKDIV D:$D(DVBAFND) SETARY
I SELDIV="N"&(RO="Y") I CFLOC=RONUM D SETARY
I SELDIV="N"&(RO="N") D SETARY
K DVBAFND
QUIT
;
SETARY ; ** Set temporary utility global **
S ^TMP($J,REQDTE,ADIV,DA)=""
QUIT
;
ADIV S ADIV=$S($D(^DVB(396,DA,2)):$P(^(2),U,9),1:"") S ADIV=$S($D(^DG(40.8,+ADIV,0)):$P(^(0),U,1),1:"Unknown Division")
Q
;
CHKDIV ;**Check for selected Div
N FLDVAR
I $D(^DVB(396,DA,6)) DO
.F FLDVAR=7,9,11,13,15,17,19,21,23,26,28 Q:$D(DVBAFND) DO
..I ($P(^DVB(396,DA,6),U,FLDVAR)=DIVNUM) DO
...I FLDVAR=7 S:$P(^DVB(396,DA,1),U,FLDVAR)="P" DVBAFND=""
...I FLDVAR'=7 S:$P(^DVB(396,DA,0),U,FLDVAR)="P" DVBAFND=""
I $D(^DVB(396,DA,2)),('$D(DVBAFND)) DO ;**Check Routing Loc Division
.I $D(^DVB(396,DA,1)) DO
..I $P(^DVB(396,DA,2),U,9)=DIVNUM,($P(^DVB(396,DA,1),U,12)="") DO
...S DVBAFND=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB57 4236 printed Dec 13, 2024@01:40:30 Page 2
DVBAB57 ;ALB/KLB - AMIE GUI PENDING 7131 REPORT ;09/7/00
+1 ;;2.7;AMIE;**35,42,185**;Apr 10, 1995;Build 18
+2 ;
STRT(MSG,SELDIV,DIV,DVBADLMTR) ;
+1 SET DVBADLMTR=$SELECT(DVBADLMTR=1:",",1:0)
+2 SET RO="N"
+3 SET RONUM=0
+4 SET DIVNUM=""
SET MSGCNT=1
+5 KILL ^TMP($JOB),^TMP("CAPRI")
+6 IF RO="Y"
IF RONUM=""
SET MSG(1)="To sort by RO Number, please enter the RO Number."
+7 IF RO="Y"
IF RONUM=""
QUIT
+8 IF SELDIV="Y"
IF DIV=""
SET MSG(1)="To sort by Division, please enter the Division."
+9 IF SELDIV="Y"
IF DIV=""
QUIT
+10 IF DIV'=""
SET DIVNUM=$ORDER(^DG(40.8,"C",DIV,DIVNUM))
SET DIVNAM=$SELECT($DATA(^DG(40.8,+DIVNUM,0)):$PIECE(^(0),"^",1),1:"Unknown Division")
SETUP DO STM^DVBCUTL4
+1 SET FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
SET (PG,DVBAQUIT)=0
+2 SET HEAD="PENDING REQUEST REPORT FOR "_$PIECE(^DVB(396.1,1,0),U,1)
+3 SET HEAD2=$SELECT(RO="Y":"FOR REGIONAL OFFICE "_RONUM,1:"ALL REGIONAL OFFICES")
+4 SET HEAD2=HEAD2_$SELECT(SELDIV="Y":", FOR DIVISION "_DIVNAM,1:", ALL DIVISIONS")
+5 SET PROCDT="Processed on: "_FDT(0)
+6 SET QQ=1
SET NODTA=0
+7 IF $GET(DVBADLMTR)=","
Begin DoDot:1
+8 SET ^TMP("CAPRI",$JOB,MSGCNT)=HEAD_$CHAR(13)
SET MSGCNT=MSGCNT+1
SET ^TMP("CAPRI",$JOB,MSGCNT)=""""_HEAD2_""""_$CHAR(13)
SET MSGCNT=MSGCNT+1
SET ^TMP("CAPRI",$JOB,MSGCNT)=PROCDT_$CHAR(13)_$CHAR(13)
SET MSGCNT=MSGCNT+1
+9 SET ^TMP("CAPRI",$JOB,MSGCNT)=$SELECT(SELDIV="Y":"Division",SELDIV="N":"Original Division",1:"")_DVBADLMTR_"Patient Name"_DVBADLMTR_"SSN"_DVBADLMTR_"Claim no."_DVBADLMTR_"Activity/Admission Date"_DVBADLMTR_"Request Date"_DVBADLMTR
+10 SET ^TMP("CAPRI",$JOB,MSGCNT)=^TMP("CAPRI",$JOB,MSGCNT)_"** Discharged"_DVBADLMTR_"Elapsed Days"_DVBADLMTR_"Items Pending"_DVBADLMTR_"Requested by Name"_DVBADLMTR_"Requested by Division"_$CHAR(13)
SET MSGCNT=MSGCNT+1
End DoDot:1
GOTO DATA
+11 IF $GET(DVBADLMTR)=0
Begin DoDot:1
+12 SET ^TMP("CAPRI",MSGCNT)="Pending 7131 Report"_"^"
SET MSGCNT=MSGCNT+1
+13 SET ^TMP("CAPRI",MSGCNT)=""_"^"
SET MSGCNT=MSGCNT+1
+14 SET ^TMP("CAPRI",MSGCNT)=HEAD_"^"
SET MSGCNT=MSGCNT+1
+15 SET ^TMP("CAPRI",MSGCNT)=HEAD2_"^"
SET MSGCNT=MSGCNT+1
+16 SET ^TMP("CAPRI",MSGCNT)=PROCDT_"^"
SET MSGCNT=MSGCNT+1
+17 SET ^TMP("CAPRI",MSGCNT)=""_"^"
SET MSGCNT=MSGCNT+1
End DoDot:1
DATA NEW REQDTE
SET REQDTE=""
SET CNT=0
+1 if SELDIV="Y"
SET ADIV=DIVNAM
+2 FOR J=0:0
SET REQDTE=$ORDER(^DVB(396,"E",REQDTE))
if REQDTE=""
QUIT
FOR DA=0:0
SET DA=$ORDER(^DVB(396,"E",REQDTE,DA))
if DA=""
QUIT
IF $DATA(^DVB(396,DA,1))
IF ($PIECE(^DVB(396,DA,1),U,12)="")
if SELDIV="N"
DO ADIV
DO MAKUTL
+3 SET (ADIV,REQDTE)=""
+4 FOR L=0:0
SET REQDTE=$ORDER(^TMP($JOB,REQDTE))
if REQDTE=""
QUIT
DO LVL2LP
+5 ;
EXIT IF NODTA=0
SET MSG(1)="No pending requests found for parameters entered."
+1 IF NODTA>0
IF $GET(DVBADLMTR)=0
SET MSG=$NAME(^TMP("CAPRI"))
+2 IF NODTA>0
IF $GET(DVBADLMTR)=","
SET MSG=$NAME(^TMP("CAPRI",$JOB))
+3 ;
KILL SET XRTN=$TEXT(+0)
+1 DO SPM^DVBCUTL4
+2 KILL ^TMP("DVBA","ADMIT",$JOB),^TMP($JOB),DVBAQUIT,SELDIV,DIVNUM,REQDTE,PROCDT,QQ,RO,RONUM,XRTN,CNT,MSGCNT,NODTA
+3 KILL LPCNT1,PATDA,DIVNAM,XJ,XI,GDIVPTR,GDIVNUM,GINSTPT,GDIVNAM,GDIV,ADIV,CFLOC,DA,DIV,FDT,HEAD,HEAD2,J,L,PG,DVBADLMTR
+4 QUIT
+5 ;
LVL2LP ; ** 2nd level of the 2nd loop in the DATA tag - search ADIV **
+1 FOR J=0:0
SET ADIV=$ORDER(^TMP($JOB,REQDTE,ADIV))
if ADIV=""
QUIT
DO LPLVL3
+2 QUIT
+3 ;
LPLVL3 ; ** 2nd level of the loop in the LVL2LP tag - search DA **
+1 FOR DA=0:0
SET DA=$ORDER(^TMP($JOB,REQDTE,ADIV,DA))
if DA=""
QUIT
DO PRINT^DVBAB67
if DVBAQUIT=1
SET ADIV="ZZZZ"
SET DA=999999999
SET REQDTE=9999999
SET QQ=1
+2 QUIT
+3 ;
MAKUTL ; ** Sort on Request Date to set up a temporary utility global **
+1 SET PATDA=$PIECE(^DVB(396,DA,0),"^",1)
+2 ;S REQDTE=$P(^DVB(396,DA,1),"^",1),PATDA=$P(^DVB(396,DA,0),"^",1)
+3 SET CFLOC=$$STATION^DVBAUTL1(PATDA)
+4 if CFLOC=-1
SET CFLOC=0
+5 IF SELDIV="Y"&(RO="Y")
IF CFLOC=RONUM
DO CHKDIV
if $DATA(DVBAFND)
DO SETARY
+6 IF SELDIV="Y"&(RO="N")
DO CHKDIV
if $DATA(DVBAFND)
DO SETARY
+7 IF SELDIV="N"&(RO="Y")
IF CFLOC=RONUM
DO SETARY
+8 IF SELDIV="N"&(RO="N")
DO SETARY
+9 KILL DVBAFND
+10 QUIT
+11 ;
SETARY ; ** Set temporary utility global **
+1 SET ^TMP($JOB,REQDTE,ADIV,DA)=""
+2 QUIT
+3 ;
ADIV SET ADIV=$SELECT($DATA(^DVB(396,DA,2)):$PIECE(^(2),U,9),1:"")
SET ADIV=$SELECT($DATA(^DG(40.8,+ADIV,0)):$PIECE(^(0),U,1),1:"Unknown Division")
+1 QUIT
+2 ;
CHKDIV ;**Check for selected Div
+1 NEW FLDVAR
+2 IF $DATA(^DVB(396,DA,6))
Begin DoDot:1
+3 FOR FLDVAR=7,9,11,13,15,17,19,21,23,26,28
if $DATA(DVBAFND)
QUIT
Begin DoDot:2
+4 IF ($PIECE(^DVB(396,DA,6),U,FLDVAR)=DIVNUM)
Begin DoDot:3
+5 IF FLDVAR=7
if $PIECE(^DVB(396,DA,1),U,FLDVAR)="P"
SET DVBAFND=""
+6 IF FLDVAR'=7
if $PIECE(^DVB(396,DA,0),U,FLDVAR)="P"
SET DVBAFND=""
End DoDot:3
End DoDot:2
End DoDot:1
+7 ;**Check Routing Loc Division
IF $DATA(^DVB(396,DA,2))
IF ('$DATA(DVBAFND))
Begin DoDot:1
+8 IF $DATA(^DVB(396,DA,1))
Begin DoDot:2
+9 IF $PIECE(^DVB(396,DA,2),U,9)=DIVNUM
IF ($PIECE(^DVB(396,DA,1),U,12)="")
Begin DoDot:3
+10 SET DVBAFND=""
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
