source: WorldVistAEHR/trunk/r/PATCH_MANAGEMNT-AAQ/AAQJADP.m@ 1042

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1AAQJADP ;FGO/JHS - Save Msgs from ADP's IN Basket ;07-02-99 [3/20/01 5:31pm]
2 ;;1.4;AAQJ PATCH RECORD;; May 14, 1999
3 ;Modified version of AAQADPXM by FGO/PJP;04-19-99
4 S U="^",AAQADP="PATCHES,ALL D",DIC="^VA(200,",DIC(0)="X",X=AAQADP D ^DIC I Y=-1 S AAQER1="This routine could not find a generic user named "_AAQADP_"." D LOG(AAQER1) W:'$D(ZTQUEUED) !,AAQER1 G EXIT
5 S AAQDA=Y,AAQDUZ=$P(AAQDA,U) ;Save the DUZ for ADP
6 S (AAQFCNT,AAQMCNT,CNT,MNUM)=0,QUOTE=$C(34)
7 K ^TMP($J) D UCI^%ZOSV S AAQUCI=$P(Y,",",1),AAQTM=$$NOW^XLFDT,BEGTM=$$FMTE^XLFDT(AAQTM),AAQER1=""
8 S AAQHDR="Message# Subject From Saved to Basket" D LOG(AAQHDR) W:'$D(ZTQUEUED) AAQHDR
9 S CNT=CNT+1,^TMP($J,CNT,0)=" " W:'$D(ZTQUEUED) !
10 S AAQX="IN",AAQIN=$$BSKT^XMAD2(AAQX,AAQDUZ) ;ADP's IN Basket S/B=1
11 F S MNUM=$O(^XMB(3.7,AAQDUZ,2,AAQIN,1,MNUM)) Q:(MNUM="C")!(MNUM="") D
12 .S AAQMCNT=AAQMCNT+1
13 .S AAQSUB=$$SUBGET^XMGAPI0(MNUM) ;Get the message subject
14 .S AAQSUBX=$E(AAQSUB,1,25)
15 .S AAQDATA=$$NET^XMRENT(MNUM) ;Get msg info, XM Prog. Manual p. 14
16 .S AAQFRMX=$P(AAQDATA,U,3) D CKFRM ;Sender of message return address
17 .S AAQSURR=$P($G(AAQDATA),U,5) ;Surrogate of Sender, if any
18 .I '$D(ZTQUEUED) W !,MNUM,?10,AAQSUBX,?37,$E(AAQFRMX,1,20)
19 .S AAQLN=7,AAQDESC="BEFORE " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D BEFORE Q
20 .S AAQLN=9,AAQDESC="Released " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
21 .S AAQLN=10,AAQDESC="New Patch " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
22 .S AAQLN=19,AAQDESC="New Released Patch " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
23 .S AAQLN=19,AAQDESC="EMERGENCY Released " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
24 .S AAQLN=6,AAQDESC="LOCAL " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
25 .S AAQLN=7,AAQDESC=" TEST v" I AAQSUB["*",AAQSUB[AAQDESC D TEST Q
26 .S AAQLN=23,AAQDESC="Changes to "_AAQUCI_" routines" I $E(AAQSUB,1,AAQLN)=AAQDESC D CHGROU Q
27 .S AAQLN=14,AAQDESC="DEACTIVATED - " I AAQFRMX[AAQADP,$E(AAQSUB,1,AAQLN)=AAQDESC D DEACT Q
28 .S AAQLN=22,AAQDESC="Option Scheduling List" I $E(AAQSUB,1,AAQLN)=AAQDESC D OPSCH Q
29 .S AAQLN=15,AAQDESC="Problem Devices" I $E(AAQSUB,1,AAQLN)=AAQDESC D PROBDEV Q
30 .S AAQQUIT=0 D CKIRM ;Messages checked for IRM Staff as Sender
31 .I AAQQUIT=0 S AAQX="",AAQBNUM="" D WRT ;Message not saved or deleted
32 .Q
33EXIT S AAQTM=$$NOW^XLFDT,ENDTM=$$FMTE^XLFDT(AAQTM)
34 S CNT=CNT+1,^TMP($J,CNT,0)=" " W:'$D(ZTQUEUED) !
35 D LOG("IN Basket Messages Read = "_AAQMCNT)
36 W:'$D(ZTQUEUED) !,"IN Basket Messages Read = "_AAQMCNT
37 D LOG("IN Basket Messages Filed = "_AAQFCNT)
38 W:'$D(ZTQUEUED) !,"IN Basket Messages Filed = "_AAQFCNT
39 S CNT=CNT+1,^TMP($J,CNT,0)=" " W:'$D(ZTQUEUED) !
40 D LOG("Start Time: "_BEGTM) W:'$D(ZTQUEUED) !,"Start Time: "_BEGTM
41 D LOG(" Stop Time: "_ENDTM) W:'$D(ZTQUEUED) !," Stop Time: "_ENDTM
42 ;Following line silently renumbers messages in ADP's IN Basket
43 S SVDUZ=DUZ,DUZ=AAQDUZ,XMK=AAQIN S X=$$REN^XMA03(DUZ,XMK),DUZ=SVDUZ
44 S CNT=CNT+1,^TMP($J,CNT,0)=" " W:'$D(ZTQUEUED) !
45 D LOG(X) W:'$D(ZTQUEUED) !,X I $D(ZTQUEUED) G MAIL
46EXITK K AAQADP,AAQBNUM,AAQDA,AAQDATA,AAQDESC,AAQDT,AAQDUZ,AAQER1,AAQFCNT,AAQFRM,AAQFRMX,AAQHDR,AAQIN,AAQINIT,AAQIRM,AAQIX,AAQLN,AAQMCNT,AAQNAME,AAQPAT,AAQQUIT,AAQSUB,AAQSUBX,AAQSURR,AAQTM,AAQUCI
47 K AAQX,AAQX1,AAQX12,AAQX2,^TMP($J),%,%2,%DT,BEGTM,CNT,DIC,ENDTM,K,MNUM,QUOTE,X,XMDUZ,XMK,XMKM,XMP,XMSUB,XMTEXT,XMY,XMZ,Y
48 Q
49BEFORE D SUBX,SETX1 S AAQX=AAQX12_" BEFORE"
50 D BSKT Q
51DEACT S AAQX="DEACTIVATED",AAQFRMX=AAQADP D BSKT Q
52CHGROU S AAQX="CHANGES TO ROUTINES",AAQFRMX="POSTMASTER" D BSKT Q
53OPSCH S AAQX="OPTION SCHEDULING",AAQFRMX="POSTMASTER" D BSKT Q
54PROBDEV S AAQX="PROBLEM DEVICES",AAQFRMX=AAQADP D BSKT Q
55PATCH D SUBX,SETX1 S AAQX=AAQX12_" PATCHES" D BSKT Q
56TEST S AAQPAT=$P(AAQSUB,AAQDESC) D SETX1 S AAQX=AAQX12_" PATCHES" D BSKT Q
57CKFRM I AAQSUB["BEFORE " S AAQFRMX=$P(AAQFRMX,"SIMPLE PATCH - ",2) Q
58 I AAQFRMX["<" S AAQFRM=$P(AAQFRMX,"<",2)
59 E S AAQFRM=AAQFRMX
60 S AAQFRMX=$P(AAQFRM,"@")
61 S AAQFRMX=$$STRIP^XLFSTR(AAQFRMX,QUOTE)
62 S AAQFRMX=$E(AAQFRMX,1,21)
63 Q
64SUBX S AAQSUBX=$P(AAQSUB,AAQDESC,2),AAQPAT=$P(AAQSUBX," ")
65 Q
66BSKT S AAQBNUM=$$BSKT^XMAD2(AAQX,AAQDUZ)
67 S XMDUZ=AAQDUZ,XMKM=AAQBNUM,XMZ=MNUM D S2^XMA1B ;Save to a basket
68 S XMKM=AAQIN D KLQ^XMA1B ;Delete message from ADP's IN Basket
69 D FILEIT Q
70SETX1 S AAQX1=$P(AAQPAT,"*",1),AAQX2=$P(AAQPAT,"*",2) D CHKLOC
71 G:AAQX2="DBA" SET12
72 I AAQX2<1 S AAQX2="0."_AAQX2 G SET12 ;Fix fraction version
73 I AAQX2'["." S AAQX2=AAQX2_".0" ;Fix whole number version
74SET12 S AAQX12=AAQX1_"*"_AAQX2 ;Fixed PKG*VER
75 Q
76CHKLOC Q:AAQX1'["Z"
77 S AAQX1=$P(AAQX1,"Z",1)
78 Q
79CKIRM F AAQIX=1:1 Q:AAQQUIT=1 Q:$P($T(IRM+AAQIX^AAQJADP),";;",2)="" D
80 .S AAQIRM=$P($T(IRM+AAQIX^AAQJADP),";;",2)
81 .S AAQNAME=$P(AAQIRM,U)
82 .I AAQFRMX["POSTMASTER",AAQSURR'="" S AAQFRMX=AAQSURR
83 .I AAQFRMX[AAQNAME D SVIRM S AAQX="(None)" Q
84 Q
85SVIRM S AAQQUIT=1,AAQINIT=$P(AAQIRM,U,2)
86 S AAQX="IRM "_AAQINIT_" MESSAGES",AAQFRMX=AAQNAME D BSKT Q
87MAIL S XMY($P(^VA(200,DUZ,0),"^"))=""
88 S XMY(AAQDUZ)=""
89 S XMDUZ=.5,AAQDT=$$FMTE^XLFDT(ENDTM,"1P")
90 S XMSUB="ADP Mail Filer Report for "_AAQUCI_" - "_AAQDT
91 S XMTEXT="^TMP($J,"
92 D ^XMD G EXITK
93FILEIT S AAQFCNT=AAQFCNT+1
94 S AAQX=$E(AAQX,1,15)
95WRT S AAQSUBX=$E(AAQSUB,1,26)
96 D LOG($E(MNUM_" ",1,10)_$E(AAQSUBX_" ",1,28)_$E(AAQFRMX_" ",1,22)_AAQX)
97 I '$D(ZTQUEUED) W ?58," "_AAQX_" "_AAQBNUM
98 Q
99LOG(MSG) ;Record message
100 S CNT=CNT+1,^TMP($J,CNT,0)=MSG
101 Q
102IRM ;;Names and Initials of IRM Staff
103 ;;ANDERSON,MARGARET A^MAA
104 ;;BAKKE,INA F^IFB
105 ;;GILBERTSON,DENNIS L^DLG
106 ;;HAYES,MICHAEL W^MWH
107 ;;KELLY,DELMER T^DTK
108 ;;MCMAINES,THERESA C^TCM
109 ;;NORAKER,DUANE O^DON
110 ;;PFAU,PETER J^PJP
111 ;;SAMS,KENNETH C^KCS
112 ;;STOXEN,JAMES H^JHS
113 ;;STOXEN,JIM^JHS
114 ;;WALKER,JOE FRANK^JFW
115 ;;WUELLNER,DIANE L^DLW
Note: See TracBrowser for help on using the repository browser.