source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGABUL.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1DGABUL ;ALB/MRL/MJK - TRANSMIT OVERDUE ABSENCE BULLETIN; 23 OCT 1990
2 ;;5.3;Registration;**418**;Aug 13, 1993
3EN ;
4 Q:'$D(DUZ)#2
5 S U="^",Y=$S($D(^DG(43,1,"CON")):$P(^("CON"),"^",7),1:"") X:Y]"" ^DD("DD")
6 W !! I Y]"" W "OVERDUE ABSENCE SEARCH WAS LAST RUN ",Y,!
7 ;
8EN1 W "TRANSMIT OVERDUE ABSENCE BULLETIN" S %=2 D YN^DICN
9 I '% W !!?4,"Y - To search for inpatients overdue from AA, UA and PASS and transmit",!?9,"bulletin to select mailgroup.",!?4,"N - If you don't wish to search for overdue absences.",! G EN1
10 D QUE:%=1,Q Q
11 ;
12ST ;
13 N DGW K ^UTILITY($J) D H^DGUTL
14 S X1=DGTIME,X2=-4 D C^%DTC S DGDAY4=X
15 S X1=DGTIME,X2=-14 D C^%DTC S DGDAY14=X
16 S X1=DGTIME,X2=-30 D C^%DTC S DGDAY30=X
17 S DGT=DGTIME,DGW="",$P(^DG(43,1,"CON"),"^",7)=DGTIME
18 ;
19 ; -- overdues
20 F I=0:0 S DGW=$O(^DPT("CN",DGW)) Q:DGW="" F DFN=0:0 S DFN=$O(^DPT("CN",DGW,DFN)) Q:'DFN D ^DGINPW I DG1,DGA1 F %=0:0 S %=$O(^DGPM("APMV",DFN,DGA1,%)) Q:'% I %,$D(^DGPM(+$O(^(%,0)),0)) S DGD=^(0) I $P(DGD,U,2)=2 D 1:DGDAY4>DGD Q
21 G Q:'$D(^UTILITY($J,"DGOVER"))
22 ;
23 ; -- re-sort util for bulletin
24 S DGW="",C=0
25 F I=0:0 S DGW=$O(^UTILITY($J,"DGOVER",DGW)) Q:DGW="" S DGNAME="" F J=0:0 S DGNAME=$O(^UTILITY($J,"DGOVER",DGW,DGNAME)) Q:DGNAME="" S C=C+1,^UTILITY($J,"DGOV",C,0)=^UTILITY($J,"DGOVER",DGW,DGNAME)
26 K ^UTILITY($J,"DGOVER")
27 D BULL
28 ;
29Q ; -- clean up
30 K ^UTILITY($J),DFN,DG1,DGA1,DGD,DGD1,DGD2,DGDAY4,DGDAY14,DGDAY30,DGT,DGTIME,DGDATE,I,I1,J,J1,X,X1,X2,Y,DGXFR0,DGPMX D KILL^DGPATV
31 D CLOSE^DGUTQ S IOP="HOME" D ^%ZIS K IOP Q
32 ;
331 ; -- process xfr
34 S DGD1=+DGD,DGD2=+$P(DGD,U,18)
35 I "^1^2^3^"'[("^"_DGD2_"^") G Q1
36 S DGD1=+DGD
37 I DGD2=1 D:DGD1<DGDAY4 S G Q1
38 I DGD2=2,"^NH^D^"[("^"_$P(^DIC(42,+DG1,0),"^",3)_"^")!($P(^DIC(42,+DG1,0),"^",17)=1) D:DGD1<DGDAY30 S G Q1 ;p-418
39 I DGD2=2 D:DGD1<DGDAY14 S G Q1
40 I DGD2=3 D:DGD1<DGDAY30 S
41Q1 Q
42 ;
43S ; -- set util w/pt data for bull
44 D ^DGPATV S Y=DGD1 X ^DD("DD") S X=$E(DGW,1,10),X1="",$P(X1," ",30)="",X=$E(X_X1,1,15),X2=$E(DGNAME,1,25)_" ("_$E($P(SSN,"^",1),6,10)_")"_X1,X=X_$E(X2,1,30)
45 S X2=$S(DGD2=1:"PASS",DGD2=2:"AA",1:"UA")_" since "_Y,X=X_X2,^UTILITY($J,"DGOVER",DGW,DGNAME)=X K X,X1,X2 Q
46 ;
47BULL ; -- send bulletin
48 G BULLQ:'$D(^UTILITY($J,"DGOV"))
49 S Y=DGTIME X ^DD("DD") S XMSUB="OVERDUE ABSENCES AS OF "_Y,XMTEXT="^UTILITY($J,""DGOV"",",DGB=8 D ^DGBUL
50BULLQ Q
51 ;
52QUE ; -- que search
53 S DGPGM="ST^DGABUL",DGVAR="DUZ^ION",ION="",X="NOW" D Q1^DGUTQ
54 W " ...BACKGROUND SEARCH QUEUED!!"
55 Q
Note: See TracBrowser for help on using the repository browser.