| [613] | 1 | DVBAFINL ;ALB/GTS-557/THM-AUTO-FINALIZE 7131 REQUESTS; 21 JUL 89
 | 
|---|
 | 2 |  ;;2.7;AMIE;**14**;Apr 10, 1995
 | 
|---|
 | 3 |  I $D(DUZ)#2=0 W *7,!!,"Your user number is not set.",!! H 3 Q
 | 
|---|
 | 4 |  I DUZ'>0 W *7,!!,"Your user number is invalid.  Please log off and back on.",!! H 3 Q
 | 
|---|
 | 5 |  ;
 | 
|---|
 | 6 | SETUP I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
 | 
|---|
 | 7 |  S OPER=$S($D(^VA(200,+DUZ,0)):$P(^(0),U,1),1:"Unknown operator"),CNT=0
 | 
|---|
 | 8 |  D HOME^%ZIS
 | 
|---|
 | 9 |  ;
 | 
|---|
 | 10 | EN W @IOF,!,"AUTOMATIC 7131 FINALIZATION - USER MODE",!!!,"This program will search the entire 7131 file",!,"and FINALIZE all requests that are ready."
 | 
|---|
 | 11 | ASK W !!,"Do you want to continue" S %=2 D YN^DICN
 | 
|---|
 | 12 |  I $D(%Y) I %Y["?" W !!,"Enter Y to go ahead and finalize all requests which are ready",!,"or N to exit.",!! H 1 G ASK
 | 
|---|
 | 13 |  G:%'=1 EXIT S %ZIS="AEQ",%ZIS("A")="Output device: " W ! D ^%ZIS K %ZIS G:POP EXIT
 | 
|---|
 | 14 |  I $D(IO("Q")) S ZTIO=ION,ZTRTN="EN1^DVBAFINL",ZTDESC="Automatic 7131 Finalization",ZTSAVE("OPER")="",ZTSAVE("CNT")=""
 | 
|---|
 | 15 |  I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G EXIT
 | 
|---|
 | 16 |  ;
 | 
|---|
 | 17 | EN1 U IO W:(IOST?1"C-".E) @IOF
 | 
|---|
 | 18 |  W !,"The following Veterans had requests automatically finalized on " S Y=DT X ^DD("DD") W Y,!!
 | 
|---|
 | 19 |  W "Veteran name",?37,"Soc Sec #",?49,"Admission date",! F LINE=1:1:IOM W "-"
 | 
|---|
 | 20 |  W !! F DFN=0:0 S DFN=$O(^DVB(396,"B",DFN)) Q:DFN=""  F DA=0:0 S DA=$O(^DVB(396,"B",DFN,DA)) Q:DA=""  D CHK1
 | 
|---|
 | 21 |  W !!,"Total requests finalized: ",$J(CNT,4,0),!!
 | 
|---|
 | 22 |  G EXIT
 | 
|---|
 | 23 |  ;
 | 
|---|
 | 24 | CHK1 ;check status of each field
 | 
|---|
 | 25 |  S NOFINAL=0
 | 
|---|
 | 26 |  I '$D(^DVB(396,DA,1)) W !!,"Bad 7131 record for internal entry # ",DA,"!...Notify IRM!!",! Q
 | 
|---|
 | 27 |  Q:$P(^DVB(396,DA,1),U,12)'=""
 | 
|---|
 | 28 |  F ZA=9,11,13,15,17,19,21,23,26,28 I $P(^DVB(396,DA,0),U,ZA)="P" S NOFINAL=1 Q
 | 
|---|
 | 29 |  Q:NOFINAL=1  I $P(^DVB(396,DA,1),U,7)="P" S NOFINAL=1 Q
 | 
|---|
 | 30 |  Q:NOFINAL=1
 | 
|---|
 | 31 |  W $P(^DPT(DFN,0),U,1),?37,$P(^DPT(DFN,0),U,9),?49 S Y=$P(^DVB(396,DA,0),U,4) X ^DD("DD") W Y,! I $Y>55 D HDR
 | 
|---|
 | 32 |  S DIE="^DVB(396,",DR="25///"_DT_";26///"_OPER D ^DIE
 | 
|---|
 | 33 |  S CNT=CNT+1 Q
 | 
|---|
 | 34 |  ;
 | 
|---|
 | 35 | EXIT I $D(ZTQUEUED)&(OPER'="Auto-finalized") D KILL^%ZTLOAD
 | 
|---|
 | 36 |  K ZA G KILL^DVBAUTIL
 | 
|---|
 | 37 |  ;
 | 
|---|
 | 38 | HDR W @IOF,!,"Automatic 7131 finalization on " S Y=DT X ^DD("DD") W Y,!!
 | 
|---|
 | 39 |  Q
 | 
|---|
 | 40 |  ;
 | 
|---|
 | 41 | ZTM D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) EXIT
 | 
|---|
 | 42 |  S OPER="Auto-finalized",CNT=0 I '$D(DT) S X="T" D ^%DT S DT=Y
 | 
|---|
 | 43 |  G EN1
 | 
|---|