DVBAFINL ;ALB/GTS-557/THM-AUTO-FINALIZE 7131 REQUESTS; 21 JUL 89
;;2.7;AMIE;**14**;Apr 10, 1995
I $D(DUZ)#2=0 W *7,!!,"Your user number is not set.",!! H 3 Q
I DUZ'>0 W *7,!!,"Your user number is invalid. Please log off and back on.",!! H 3 Q
;
SETUP I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
S OPER=$S($D(^VA(200,+DUZ,0)):$P(^(0),U,1),1:"Unknown operator"),CNT=0
D HOME^%ZIS
;
EN W @IOF,!,"AUTOMATIC 7131 FINALIZATION - USER MODE",!!!,"This program will search the entire 7131 file",!,"and FINALIZE all requests that are ready."
ASK W !!,"Do you want to continue" S %=2 D YN^DICN
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
G:%'=1 EXIT S %ZIS="AEQ",%ZIS("A")="Output device: " W ! D ^%ZIS K %ZIS G:POP EXIT
I $D(IO("Q")) S ZTIO=ION,ZTRTN="EN1^DVBAFINL",ZTDESC="Automatic 7131 Finalization",ZTSAVE("OPER")="",ZTSAVE("CNT")=""
I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G EXIT
;
EN1 U IO W:(IOST?1"C-".E) @IOF
W !,"The following Veterans had requests automatically finalized on " S Y=DT X ^DD("DD") W Y,!!
W "Veteran name",?37,"Soc Sec #",?49,"Admission date",! F LINE=1:1:IOM W "-"
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
W !!,"Total requests finalized: ",$J(CNT,4,0),!!
G EXIT
;
CHK1 ;check status of each field
S NOFINAL=0
I '$D(^DVB(396,DA,1)) W !!,"Bad 7131 record for internal entry # ",DA,"!...Notify IRM!!",! Q
Q:$P(^DVB(396,DA,1),U,12)'=""
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
Q:NOFINAL=1 I $P(^DVB(396,DA,1),U,7)="P" S NOFINAL=1 Q
Q:NOFINAL=1
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
S DIE="^DVB(396,",DR="25///"_DT_";26///"_OPER D ^DIE
S CNT=CNT+1 Q
;
EXIT I $D(ZTQUEUED)&(OPER'="Auto-finalized") D KILL^%ZTLOAD
K ZA G KILL^DVBAUTIL
;
HDR W @IOF,!,"Automatic 7131 finalization on " S Y=DT X ^DD("DD") W Y,!!
Q
;
ZTM D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) EXIT
S OPER="Auto-finalized",CNT=0 I '$D(DT) S X="T" D ^%DT S DT=Y
G EN1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAFINL 2176 printed Nov 22, 2024@16:51:26 Page 2
DVBAFINL ;ALB/GTS-557/THM-AUTO-FINALIZE 7131 REQUESTS; 21 JUL 89
+1 ;;2.7;AMIE;**14**;Apr 10, 1995
+2 IF $DATA(DUZ)#2=0
WRITE *7,!!,"Your user number is not set.",!!
HANG 3
QUIT
+3 IF DUZ'>0
WRITE *7,!!,"Your user number is invalid. Please log off and back on.",!!
HANG 3
QUIT
+4 ;
SETUP IF '$DATA(DT)
SET %DT=""
SET X="T"
DO ^%DT
SET DT=Y
+1 SET OPER=$SELECT($DATA(^VA(200,+DUZ,0)):$PIECE(^(0),U,1),1:"Unknown operator")
SET CNT=0
+2 DO HOME^%ZIS
+3 ;
EN WRITE @IOF,!,"AUTOMATIC 7131 FINALIZATION - USER MODE",!!!,"This program will search the entire 7131 file",!,"and FINALIZE all requests that are ready."
ASK WRITE !!,"Do you want to continue"
SET %=2
DO YN^DICN
+1 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y to go ahead and finalize all requests which are ready",!,"or N to exit.",!!
HANG 1
GOTO ASK
+2 if %'=1
GOTO EXIT
SET %ZIS="AEQ"
SET %ZIS("A")="Output device: "
WRITE !
DO ^%ZIS
KILL %ZIS
if POP
GOTO EXIT
+3 IF $DATA(IO("Q"))
SET ZTIO=ION
SET ZTRTN="EN1^DVBAFINL"
SET ZTDESC="Automatic 7131 Finalization"
SET ZTSAVE("OPER")=""
SET ZTSAVE("CNT")=""
+4 IF $DATA(IO("Q"))
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !!,"Request queued.",!!
GOTO EXIT
+5 ;
EN1 USE IO
if (IOST?1"C-".E)
WRITE @IOF
+1 WRITE !,"The following Veterans had requests automatically finalized on "
SET Y=DT
XECUTE ^DD("DD")
WRITE Y,!!
+2 WRITE "Veteran name",?37,"Soc Sec #",?49,"Admission date",!
FOR LINE=1:1:IOM
WRITE "-"
+3 WRITE !!
FOR DFN=0:0
SET DFN=$ORDER(^DVB(396,"B",DFN))
if DFN=""
QUIT
FOR DA=0:0
SET DA=$ORDER(^DVB(396,"B",DFN,DA))
if DA=""
QUIT
DO CHK1
+4 WRITE !!,"Total requests finalized: ",$JUSTIFY(CNT,4,0),!!
+5 GOTO EXIT
+6 ;
CHK1 ;check status of each field
+1 SET NOFINAL=0
+2 IF '$DATA(^DVB(396,DA,1))
WRITE !!,"Bad 7131 record for internal entry # ",DA,"!...Notify IRM!!",!
QUIT
+3 if $PIECE(^DVB(396,DA,1),U,12)'=""
QUIT
+4 FOR ZA=9,11,13,15,17,19,21,23,26,28
IF $PIECE(^DVB(396,DA,0),U,ZA)="P"
SET NOFINAL=1
QUIT
+5 if NOFINAL=1
QUIT
IF $PIECE(^DVB(396,DA,1),U,7)="P"
SET NOFINAL=1
QUIT
+6 if NOFINAL=1
QUIT
+7 WRITE $PIECE(^DPT(DFN,0),U,1),?37,$PIECE(^DPT(DFN,0),U,9),?49
SET Y=$PIECE(^DVB(396,DA,0),U,4)
XECUTE ^DD("DD")
WRITE Y,!
IF $Y>55
DO HDR
+8 SET DIE="^DVB(396,"
SET DR="25///"_DT_";26///"_OPER
DO ^DIE
+9 SET CNT=CNT+1
QUIT
+10 ;
EXIT IF $DATA(ZTQUEUED)&(OPER'="Auto-finalized")
DO KILL^%ZTLOAD
+1 KILL ZA
GOTO KILL^DVBAUTIL
+2 ;
HDR WRITE @IOF,!,"Automatic 7131 finalization on "
SET Y=DT
XECUTE ^DD("DD")
WRITE Y,!!
+1 QUIT
+2 ;
ZTM DO NOPARM^DVBAUTL2
if $DATA(DVBAQUIT)
GOTO EXIT
+1 SET OPER="Auto-finalized"
SET CNT=0
IF '$DATA(DT)
SET X="T"
DO ^%DT
SET DT=Y
+2 GOTO EN1
