| [613] | 1 | DVBAPEND ;ALB/GTS-557/THM-PENDING REPORT ; 7/6/90 1:18 PM
|
|---|
| 2 | ;;2.7;AMIE;**17**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
|
|---|
| 5 | TERM D HOME^%ZIS W @IOF,!,"Pending 7131 Report",!!! K NOASK,^TMP($J)
|
|---|
| 6 | S DVBADD=^DD("DD"),(RONUM,Y)=0 D SORT^DVBAUTIL G:Y<0 KILL
|
|---|
| 7 | D SORTDIV^DVBAPND1 G:Y<0 KILL S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL
|
|---|
| 8 | ;
|
|---|
| 9 | QUEUE I $D(IO("Q")) S ZTRTN="SETUP^DVBAPEND",ZTIO=ION,ZTDESC="AMIE PENDING REPORT",NOASK=1 F I="DIVNAM","SELDIV","DVBADD","RONUM","RO","NOASK","Y","DIVNUM" S ZTSAVE(I)=""
|
|---|
| 10 | I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! H 1 G KILL
|
|---|
| 11 | ;
|
|---|
| 12 | SETUP D STM^DVBCUTL4
|
|---|
| 13 | S FDT(0)=$$FMTE^XLFDT(DT,"5DZ"),(PG,DVBAQUIT)=0
|
|---|
| 14 | S HEAD="PENDING REQUEST REPORT FOR "_$P(^DVB(396.1,1,0),U,1)
|
|---|
| 15 | S HEAD2=$S(RO="Y":"FOR REGIONAL OFFICE "_RONUM,1:"ALL REGIONAL OFFICES")
|
|---|
| 16 | S HEAD2=HEAD2_$S(SELDIV="Y":", FOR DIVISION "_DIVNAM,1:", ALL DIVISIONS")
|
|---|
| 17 | S PROCDT="Processed on: "_FDT(0)
|
|---|
| 18 | S QQ=1,NODTA=0 U IO D HEADER^DVBAPND1
|
|---|
| 19 | DATA N REQDTE S REQDTE=""
|
|---|
| 20 | S:SELDIV="Y" ADIV=DIVNAM
|
|---|
| 21 | 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
|
|---|
| 22 | S (ADIV,REQDTE)=""
|
|---|
| 23 | F L=0:0 S REQDTE=$O(^TMP($J,REQDTE)) Q:REQDTE="" D LVL2LP
|
|---|
| 24 | ;
|
|---|
| 25 | EXIT I NODTA=0 U IO W *7,"No pending requests found for parameters entered.",!!
|
|---|
| 26 | ;
|
|---|
| 27 | KILL S XRTN=$T(+0)
|
|---|
| 28 | D SPM^DVBCUTL4
|
|---|
| 29 | K ^TMP("DVBA","ADMIT",$J),^TMP($J),DVBAQUIT,SELDIV,DIVNUM,REQDTE
|
|---|
| 30 | K LPCNT1,PATDA,DIVNAM,XJ,XI,GDIVPTR,GDIVNUM,GINSTPT,GDIVNAM,GDIV
|
|---|
| 31 | D:$D(ZTQUEUED) KILL^%ZTLOAD G KILL^DVBAUTIL
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | LVL2LP ; ** 2nd level of the 2nd loop in the DATA tag - search ADIV **
|
|---|
| 35 | F J=0:0 S ADIV=$O(^TMP($J,REQDTE,ADIV)) Q:ADIV="" D LPLVL3
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | LPLVL3 ; ** 2nd level of the loop in the LVL2LP tag - search DA **
|
|---|
| 39 | F DA=0:0 S DA=$O(^TMP($J,REQDTE,ADIV,DA)) Q:DA="" D PRINT^DVBAPND1 S:DVBAQUIT=1 ADIV="ZZZZ",DA=999999999,REQDTE=9999999 S QQ=1
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | MAKUTL ; ** Sort on Request Date to set up a temporary utility global **
|
|---|
| 43 | S REQDTE=$P(^DVB(396,DA,1),"^",1),PATDA=$P(^DVB(396,DA,0),"^",1)
|
|---|
| 44 | S CFLOC=$$STATION^DVBAUTL1(PATDA)
|
|---|
| 45 | S:CFLOC=-1 CFLOC=0
|
|---|
| 46 | I SELDIV="Y"&(RO="Y") I CFLOC=RONUM D CHKDIV D:$D(DVBAFND) SETARY
|
|---|
| 47 | I SELDIV="Y"&(RO="N") D CHKDIV D:$D(DVBAFND) SETARY
|
|---|
| 48 | I SELDIV="N"&(RO="Y") I CFLOC=RONUM D SETARY
|
|---|
| 49 | I SELDIV="N"&(RO="N") D SETARY
|
|---|
| 50 | K DVBAFND
|
|---|
| 51 | QUIT
|
|---|
| 52 | ;
|
|---|
| 53 | SETARY ; ** Set temporary utility global **
|
|---|
| 54 | S ^TMP($J,REQDTE,ADIV,DA)=""
|
|---|
| 55 | QUIT
|
|---|
| 56 | ;
|
|---|
| 57 | 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")
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | CHKDIV ;**Check for selected Div
|
|---|
| 61 | N FLDVAR
|
|---|
| 62 | I $D(^DVB(396,DA,6)) DO
|
|---|
| 63 | .F FLDVAR=7,9,11,13,15,17,19,21,23,26,28 Q:$D(DVBAFND) DO
|
|---|
| 64 | ..I ($P(^DVB(396,DA,6),U,FLDVAR)=DIVNUM) DO
|
|---|
| 65 | ...I FLDVAR=7 S:$P(^DVB(396,DA,1),U,FLDVAR)="P" DVBAFND=""
|
|---|
| 66 | ...I FLDVAR'=7 S:$P(^DVB(396,DA,0),U,FLDVAR)="P" DVBAFND=""
|
|---|
| 67 | I $D(^DVB(396,DA,2)),('$D(DVBAFND)) DO ;**Check Routing Loc Division
|
|---|
| 68 | .I $D(^DVB(396,DA,1)) DO
|
|---|
| 69 | ..I $P(^DVB(396,DA,2),U,9)=DIVNUM,($P(^DVB(396,DA,1),U,12)="") DO
|
|---|
| 70 | ...S DVBAFND=""
|
|---|
| 71 | Q
|
|---|
