| [613] | 1 | DVBAREQS ;ALB ISC/THM-SHORT RPT FOR NEW 7131 REQUESTS; 21 JUL 89@0129
|
|---|
| 2 | ;;2.7;AMIE;**2,17**;Apr 10, 1995
|
|---|
| 3 | ;called by DVBAREQ1 for short version of new requests
|
|---|
| 4 | ;
|
|---|
| 5 | SETUP S %DT="AE",DIC="^DVB(396,",BDT1=$$FMTE^XLFDT(BDT,"5DZ"),EDT1=$$FMTE^XLFDT(EDT,"5DZ")
|
|---|
| 6 | I XDIV'="ALL" S (BDIV,EDIV)=$P(^DG(40.8,XDIV,0),U,1)
|
|---|
| 7 | I XDIV="ALL" S BDIV="@",EDIV=""
|
|---|
| 8 | ;
|
|---|
| 9 | INFO S DHD="VARO 7131 NEW REQUEST REPORT FOR "_BDT1_" TO "_EDT1_" * SHORT VERSION *",L=0,FLDS=".01;L15,1;L12,2;L12,NUMDATE4(#3);L10;""ACT/ADM DATE"",23;L11,29;L9"
|
|---|
| 10 | S ^TMP(396,$J,1,2,3,4,5,6)=""
|
|---|
| 11 | S DIOBEG="K ^TMP(396,$J) D TMPSET^DVBAREQS(BDT,EDT,XDIV)"
|
|---|
| 12 | S (FR(0),TO(0))=""
|
|---|
| 13 | S DISPAR(0,2)="^;""DOCUMENT TYPE: "";S2"
|
|---|
| 14 | S BY(0)="^TMP(396,$J,",L(0)=6
|
|---|
| 15 | S DHIT="I $P($G(^DVB(396,D0,2)),U,9)="""" W ?9,""** REGIONAL OFFICE MUST EDIT THE INCOMPLETE REQUEST LISTED ABOVE **"",!"
|
|---|
| 16 | ;
|
|---|
| 17 | PRINT D EN1^DIP
|
|---|
| 18 | ;
|
|---|
| 19 | EXIT K FR,BY,DIS,DHIT,TO,L,FLDS,DHD,^TMP(396,$J),DIOBEG,FR(0),TO(0),BY(0),L(0)
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | NAME ;this is called from DVBAREQ1 when a selection is made by name.
|
|---|
| 23 | S DHD="VARO 7131 NEW REQUEST REPORT FOR "_$P(DA,U,2)_" * SHORT VERSION *",(FR,TO)=+DA,BY="@NUMBER"
|
|---|
| 24 | S L=0,DIC="^DVB(396,"
|
|---|
| 25 | S FLDS=".01;L15,1;L12,2;L12,NUMDATE4(#3);L10;""ACT/ADM DATE"",23;L11,29;L9"
|
|---|
| 26 | D PRINT
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | VERSION() ;Get whether user wants long or short version
|
|---|
| 30 | N DTOUT,DUOUT,Y
|
|---|
| 31 | S DIR(0)="SM^L:Long;S:Short",DIR("A")="Select version",DIR("B")="Long"
|
|---|
| 32 | D ^DIR
|
|---|
| 33 | K DIR
|
|---|
| 34 | I $D(DTOUT)!($D(DUOUT)) Q 0
|
|---|
| 35 | Q $S(Y="L"!(Y="S"):Y,1:0)
|
|---|
| 36 | ;
|
|---|
| 37 | KILL1 ;
|
|---|
| 38 | K DVBDA,DVBVER,DA,NODTA,QQ,DVBAON2,^TMP($J),VAR
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | KILL S XRTN=$T(+0)
|
|---|
| 42 | D SPM^DVBCUTL4
|
|---|
| 43 | I $D(ZTQUEUED)&($D(DVBAMAN)) D KILL^%ZTLOAD
|
|---|
| 44 | K DVBAON2,DVBAMAN,^TMP($J),LPDIV,DVBOUT,DVBSEL,VAR,DVBVER,DVBDA,DVBATASK,DVBSTOP
|
|---|
| 45 | D KILL^DVBAUTIL
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | TMPSET(BDT,EDT,XDIV) ;**Set ^TMP X-Ref for short report
|
|---|
| 49 | ;** ^TMP("396",$J) array returned and must be KILLed by calling rtn
|
|---|
| 50 | N LPDT,LPDIV,LPDA,DOCTYPE,DTOFREQ,DIV,PATNAME,TYPEORD
|
|---|
| 51 | F LPDT=((BDT-1)+.2359):0 S LPDT=$O(^DVB(396,"AE",LPDT)) Q:LPDT>EDT!(LPDT="") DO
|
|---|
| 52 | .S:XDIV'="ALL" LPDIV=+XDIV-1
|
|---|
| 53 | .S:XDIV="ALL" LPDIV=""
|
|---|
| 54 | .F S LPDIV=$O(^DVB(396,"AE",LPDT,LPDIV)) Q:(LPDIV=""!(XDIV'="ALL"&(XDIV'=LPDIV))) DO
|
|---|
| 55 | ..F LPDA=0:0 S LPDA=$O(^DVB(396,"AE",LPDT,LPDIV,LPDA)) Q:LPDA="" DO
|
|---|
| 56 | ...S DOCTYPE=$P($G(^DVB(396,LPDA,2)),U,10)
|
|---|
| 57 | ...S TYPEORD=$S(DOCTYPE="A":1,DOCTYPE="L":2,1:3)
|
|---|
| 58 | ...S DOCTYPE=$S(DOCTYPE="A":"ADMISSION DATE",DOCTYPE="L":"ACTIVITY DATE",1:"")
|
|---|
| 59 | ...S DTOFREQ=$P($G(^DVB(396,LPDA,1)),U,1)
|
|---|
| 60 | ...S DIV=$P($G(^DVB(396,LPDA,2)),U,9)
|
|---|
| 61 | ...S PATNAME=$P($G(^DVB(396,LPDA,0)),U,1)
|
|---|
| 62 | ...S ^TMP("396",$J,TYPEORD,DOCTYPE,DTOFREQ,DIV,PATNAME,LPDA)=""
|
|---|
| 63 | Q
|
|---|
