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

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