source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAFINL.m@ 1605

Last change on this file since 1605 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1DVBAFINL ;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 ;
6SETUP 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 ;
10EN W @IOF,!,"AUTOMATIC 7131 FINALIZATION - USER MODE",!!!,"This program will search the entire 7131 file",!,"and FINALIZE all requests that are ready."
11ASK 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 ;
17EN1 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 ;
24CHK1 ;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 ;
35EXIT I $D(ZTQUEUED)&(OPER'="Auto-finalized") D KILL^%ZTLOAD
36 K ZA G KILL^DVBAUTIL
37 ;
38HDR W @IOF,!,"Automatic 7131 finalization on " S Y=DT X ^DD("DD") W Y,!!
39 Q
40 ;
41ZTM 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
Note: See TracBrowser for help on using the repository browser.