| 1 | DVBADSR1 ;ALB/GTS-557/THM-REPRINT AMIE NOTICE OF DISCHARGE ;21 JUL 89
|
|---|
| 2 | ;;2.7;AMIE;**17**;Apr 10, 1995
|
|---|
| 3 | D HOME^%ZIS
|
|---|
| 4 | D DUZ2^DVBAUTIL I $D(DVBAQUIT) K DVBAQUIT G EXIT
|
|---|
| 5 | ;
|
|---|
| 6 | SETUP S HD="SINGLE NOTICE OF DISCHARGE REPRINTING"
|
|---|
| 7 | D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
|
|---|
| 8 | S HEAD="NOTICE OF DISCHARGE",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
|
|---|
| 9 | ;
|
|---|
| 10 | EN W @IOF,!?(IOM-$L(HD)\2),HD,!!
|
|---|
| 11 | S DIC="^DVB(396.2,",DIC(0)="AEQM",DIC("A")="Enter NAME to reprint: "
|
|---|
| 12 | S DIC("W")="S DFN=$P(^DVB(396.2,+Y,0),U,1),ADM=$P(^(0),U,3) I $D(^DGPM(+ADM,0)),$P(^(0),U,17)]"""" S DCHPTR=$P(^(0),U,17),DISCH=$S($P(^DGPM(DCHPTR,0),U,1)]"""":$P(^(0),U,1),1:"""") X DVBA(""W"")"
|
|---|
| 13 | S DVBA("W")="W:$X>50 ! W ?($X+5),""Discharge date: "",$$FMTE^XLFDT(DISCH,""5DZ"")"
|
|---|
| 14 | D ^DIC I X=""!(X=U) K DVBA G EXIT
|
|---|
| 15 | I +Y<0 W *7," ??" H 1 G EN
|
|---|
| 16 | I $P(^DVB(396.2,+Y,0),U,7)'=DVBAD2 W *7,!!,"This does not belong to your RO.",!! H 3 G EN
|
|---|
| 17 | I +Y>0 S XDA=+Y,DA=$P(^DVB(396.2,+Y,0),U,1),ADMDT=$P(^(0),U,2),MB=$P(^(0),U,3)
|
|---|
| 18 | S %ZIS("B")="0;P-OTHER",%ZIS="AEQ",%ZIS("A")="Output device: " D ^%ZIS K %ZIS
|
|---|
| 19 | I $D(IO("Q")) S ZTIO=ION,ZTRTN="REPRINT^DVBADSNT",ZTDESC="Reprint notice of discharge" F I="H*","D*","FDT*","A*","XDA","MB" S ZTSAVE(I)=""
|
|---|
| 20 | I D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued",!! H 2 G KILL^DVBAUTIL
|
|---|
| 21 | I POP G KILL^DVBAUTIL
|
|---|
| 22 | D REPRINT^DVBADSNT K ^TMP($J) G SETUP
|
|---|
| 23 | ;
|
|---|
| 24 | EXIT G KILL^DVBAUTIL
|
|---|
