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

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