116 lines
5.6 KiB
Mathematica
116 lines
5.6 KiB
Mathematica
AAQJADP ;FGO/JHS - Save Msgs from ADP's IN Basket ;07-02-99 [3/20/01 5:31pm]
|
|
;;1.4;AAQJ PATCH RECORD;; May 14, 1999
|
|
;Modified version of AAQADPXM by FGO/PJP;04-19-99
|
|
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
|
|
S AAQDA=Y,AAQDUZ=$P(AAQDA,U) ;Save the DUZ for ADP
|
|
S (AAQFCNT,AAQMCNT,CNT,MNUM)=0,QUOTE=$C(34)
|
|
K ^TMP($J) D UCI^%ZOSV S AAQUCI=$P(Y,",",1),AAQTM=$$NOW^XLFDT,BEGTM=$$FMTE^XLFDT(AAQTM),AAQER1=""
|
|
S AAQHDR="Message# Subject From Saved to Basket" D LOG(AAQHDR) W:'$D(ZTQUEUED) AAQHDR
|
|
S CNT=CNT+1,^TMP($J,CNT,0)=" " W:'$D(ZTQUEUED) !
|
|
S AAQX="IN",AAQIN=$$BSKT^XMAD2(AAQX,AAQDUZ) ;ADP's IN Basket S/B=1
|
|
F S MNUM=$O(^XMB(3.7,AAQDUZ,2,AAQIN,1,MNUM)) Q:(MNUM="C")!(MNUM="") D
|
|
.S AAQMCNT=AAQMCNT+1
|
|
.S AAQSUB=$$SUBGET^XMGAPI0(MNUM) ;Get the message subject
|
|
.S AAQSUBX=$E(AAQSUB,1,25)
|
|
.S AAQDATA=$$NET^XMRENT(MNUM) ;Get msg info, XM Prog. Manual p. 14
|
|
.S AAQFRMX=$P(AAQDATA,U,3) D CKFRM ;Sender of message return address
|
|
.S AAQSURR=$P($G(AAQDATA),U,5) ;Surrogate of Sender, if any
|
|
.I '$D(ZTQUEUED) W !,MNUM,?10,AAQSUBX,?37,$E(AAQFRMX,1,20)
|
|
.S AAQLN=7,AAQDESC="BEFORE " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D BEFORE Q
|
|
.S AAQLN=9,AAQDESC="Released " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
|
|
.S AAQLN=10,AAQDESC="New Patch " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
|
|
.S AAQLN=19,AAQDESC="New Released Patch " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
|
|
.S AAQLN=19,AAQDESC="EMERGENCY Released " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
|
|
.S AAQLN=6,AAQDESC="LOCAL " I AAQSUB["*",$E(AAQSUB,1,AAQLN)=AAQDESC D PATCH Q
|
|
.S AAQLN=7,AAQDESC=" TEST v" I AAQSUB["*",AAQSUB[AAQDESC D TEST Q
|
|
.S AAQLN=23,AAQDESC="Changes to "_AAQUCI_" routines" I $E(AAQSUB,1,AAQLN)=AAQDESC D CHGROU Q
|
|
.S AAQLN=14,AAQDESC="DEACTIVATED - " I AAQFRMX[AAQADP,$E(AAQSUB,1,AAQLN)=AAQDESC D DEACT Q
|
|
.S AAQLN=22,AAQDESC="Option Scheduling List" I $E(AAQSUB,1,AAQLN)=AAQDESC D OPSCH Q
|
|
.S AAQLN=15,AAQDESC="Problem Devices" I $E(AAQSUB,1,AAQLN)=AAQDESC D PROBDEV Q
|
|
.S AAQQUIT=0 D CKIRM ;Messages checked for IRM Staff as Sender
|
|
.I AAQQUIT=0 S AAQX="",AAQBNUM="" D WRT ;Message not saved or deleted
|
|
.Q
|
|
EXIT S AAQTM=$$NOW^XLFDT,ENDTM=$$FMTE^XLFDT(AAQTM)
|
|
S CNT=CNT+1,^TMP($J,CNT,0)=" " W:'$D(ZTQUEUED) !
|
|
D LOG("IN Basket Messages Read = "_AAQMCNT)
|
|
W:'$D(ZTQUEUED) !,"IN Basket Messages Read = "_AAQMCNT
|
|
D LOG("IN Basket Messages Filed = "_AAQFCNT)
|
|
W:'$D(ZTQUEUED) !,"IN Basket Messages Filed = "_AAQFCNT
|
|
S CNT=CNT+1,^TMP($J,CNT,0)=" " W:'$D(ZTQUEUED) !
|
|
D LOG("Start Time: "_BEGTM) W:'$D(ZTQUEUED) !,"Start Time: "_BEGTM
|
|
D LOG(" Stop Time: "_ENDTM) W:'$D(ZTQUEUED) !," Stop Time: "_ENDTM
|
|
;Following line silently renumbers messages in ADP's IN Basket
|
|
S SVDUZ=DUZ,DUZ=AAQDUZ,XMK=AAQIN S X=$$REN^XMA03(DUZ,XMK),DUZ=SVDUZ
|
|
S CNT=CNT+1,^TMP($J,CNT,0)=" " W:'$D(ZTQUEUED) !
|
|
D LOG(X) W:'$D(ZTQUEUED) !,X I $D(ZTQUEUED) G MAIL
|
|
EXITK 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
|
|
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
|
|
Q
|
|
BEFORE D SUBX,SETX1 S AAQX=AAQX12_" BEFORE"
|
|
D BSKT Q
|
|
DEACT S AAQX="DEACTIVATED",AAQFRMX=AAQADP D BSKT Q
|
|
CHGROU S AAQX="CHANGES TO ROUTINES",AAQFRMX="POSTMASTER" D BSKT Q
|
|
OPSCH S AAQX="OPTION SCHEDULING",AAQFRMX="POSTMASTER" D BSKT Q
|
|
PROBDEV S AAQX="PROBLEM DEVICES",AAQFRMX=AAQADP D BSKT Q
|
|
PATCH D SUBX,SETX1 S AAQX=AAQX12_" PATCHES" D BSKT Q
|
|
TEST S AAQPAT=$P(AAQSUB,AAQDESC) D SETX1 S AAQX=AAQX12_" PATCHES" D BSKT Q
|
|
CKFRM I AAQSUB["BEFORE " S AAQFRMX=$P(AAQFRMX,"SIMPLE PATCH - ",2) Q
|
|
I AAQFRMX["<" S AAQFRM=$P(AAQFRMX,"<",2)
|
|
E S AAQFRM=AAQFRMX
|
|
S AAQFRMX=$P(AAQFRM,"@")
|
|
S AAQFRMX=$$STRIP^XLFSTR(AAQFRMX,QUOTE)
|
|
S AAQFRMX=$E(AAQFRMX,1,21)
|
|
Q
|
|
SUBX S AAQSUBX=$P(AAQSUB,AAQDESC,2),AAQPAT=$P(AAQSUBX," ")
|
|
Q
|
|
BSKT S AAQBNUM=$$BSKT^XMAD2(AAQX,AAQDUZ)
|
|
S XMDUZ=AAQDUZ,XMKM=AAQBNUM,XMZ=MNUM D S2^XMA1B ;Save to a basket
|
|
S XMKM=AAQIN D KLQ^XMA1B ;Delete message from ADP's IN Basket
|
|
D FILEIT Q
|
|
SETX1 S AAQX1=$P(AAQPAT,"*",1),AAQX2=$P(AAQPAT,"*",2) D CHKLOC
|
|
G:AAQX2="DBA" SET12
|
|
I AAQX2<1 S AAQX2="0."_AAQX2 G SET12 ;Fix fraction version
|
|
I AAQX2'["." S AAQX2=AAQX2_".0" ;Fix whole number version
|
|
SET12 S AAQX12=AAQX1_"*"_AAQX2 ;Fixed PKG*VER
|
|
Q
|
|
CHKLOC Q:AAQX1'["Z"
|
|
S AAQX1=$P(AAQX1,"Z",1)
|
|
Q
|
|
CKIRM F AAQIX=1:1 Q:AAQQUIT=1 Q:$P($T(IRM+AAQIX^AAQJADP),";;",2)="" D
|
|
.S AAQIRM=$P($T(IRM+AAQIX^AAQJADP),";;",2)
|
|
.S AAQNAME=$P(AAQIRM,U)
|
|
.I AAQFRMX["POSTMASTER",AAQSURR'="" S AAQFRMX=AAQSURR
|
|
.I AAQFRMX[AAQNAME D SVIRM S AAQX="(None)" Q
|
|
Q
|
|
SVIRM S AAQQUIT=1,AAQINIT=$P(AAQIRM,U,2)
|
|
S AAQX="IRM "_AAQINIT_" MESSAGES",AAQFRMX=AAQNAME D BSKT Q
|
|
MAIL S XMY($P(^VA(200,DUZ,0),"^"))=""
|
|
S XMY(AAQDUZ)=""
|
|
S XMDUZ=.5,AAQDT=$$FMTE^XLFDT(ENDTM,"1P")
|
|
S XMSUB="ADP Mail Filer Report for "_AAQUCI_" - "_AAQDT
|
|
S XMTEXT="^TMP($J,"
|
|
D ^XMD G EXITK
|
|
FILEIT S AAQFCNT=AAQFCNT+1
|
|
S AAQX=$E(AAQX,1,15)
|
|
WRT S AAQSUBX=$E(AAQSUB,1,26)
|
|
D LOG($E(MNUM_" ",1,10)_$E(AAQSUBX_" ",1,28)_$E(AAQFRMX_" ",1,22)_AAQX)
|
|
I '$D(ZTQUEUED) W ?58," "_AAQX_" "_AAQBNUM
|
|
Q
|
|
LOG(MSG) ;Record message
|
|
S CNT=CNT+1,^TMP($J,CNT,0)=MSG
|
|
Q
|
|
IRM ;;Names and Initials of IRM Staff
|
|
;;ANDERSON,MARGARET A^MAA
|
|
;;BAKKE,INA F^IFB
|
|
;;GILBERTSON,DENNIS L^DLG
|
|
;;HAYES,MICHAEL W^MWH
|
|
;;KELLY,DELMER T^DTK
|
|
;;MCMAINES,THERESA C^TCM
|
|
;;NORAKER,DUANE O^DON
|
|
;;PFAU,PETER J^PJP
|
|
;;SAMS,KENNETH C^KCS
|
|
;;STOXEN,JAMES H^JHS
|
|
;;STOXEN,JIM^JHS
|
|
;;WALKER,JOE FRANK^JFW
|
|
;;WUELLNER,DIANE L^DLW
|