| 1 | PSXVCK ;BIR/WPB-Routine to check for Release Data Ack MSG ;10/23/98 1:06 PM
|
---|
| 2 | ;;2.0;CMOP;**19,38**;11 Apr 97
|
---|
| 3 | EN Q:'$D(^PSX(554,"AF"))
|
---|
| 4 | S DIC="^PSX(552,",DIC(0)="AEQMZ",DIC("A")="Select Facility or RETURN for all: "
|
---|
| 5 | D ^DIC K DIC G:$D(DUOUT)!($D(DTOUT))!(X["^") EX S SITE1=$P($G(Y),"^",2) K Y,X,DIC,DIC("A"),DIC(0),DUOUT,DTOUT
|
---|
| 6 | S:$G(SITE1)'>0 SITE1=0
|
---|
| 7 | ;I $G(SITE1)>0 S SS=SITE1,X=SITE1,DIC="4",DIC(0)="XMZO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITENAME=$P(Y,"^",2) K XX,X,Y,DIC S SP=(54-$L(SITENAME))/2 ;****DOD L1
|
---|
| 8 | I $G(SITE1)>0 S SS=SITE1,X=SITE1,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S Y=$$IEN^XUMF(4,AGNCY,X) S SITENAME=$$GET1^DIQ(4,Y,.01) K XX,X,Y,DIC,AGNCY S SP=(54-$L(SITENAME))/2 ;****DOD L1
|
---|
| 9 | S XXZ=$O(^PSX(554,"AS","")) S:$G(XXZ)'>0 SN=$$HADD^XLFDT($H,-14,0,0,0) S:$G(XXZ)>0 SN=$$HADD^XLFDT($H,-$P(^PSX(554,1,1,XXZ,0),"^",8),0,0,0) S:$G(SN)'="" SNC=$P($$HTE^XLFDT(SN),"@",1)
|
---|
| 10 | DEV S %ZIS="Q" D ^%ZIS S PGL=($G(IOSL)-2) I POP W !,"No Device Selected!" G EX
|
---|
| 11 | I $D(IO("Q")) D QUE Q
|
---|
| 12 | I $G(SITE1)=0 D WORK
|
---|
| 13 | I $G(SITE1)>0 D WORK1
|
---|
| 14 | G EX1
|
---|
| 15 | QUE I $D(IO("Q")) S ZTRTN=$S($G(SITE1)'>0:"WORK^PSXVCK",$G(SITE1)>0:"WORK1^PSXVCK",1:""),ZTDESC="CMOP Rx Release Summary",ZTDTH="",ZTSAVE("SNC")="",ZTSAVE("SITE1")="",ZTSAVE("SITENAME")="",ZTSAVE("SN")="",ZTSAVE("PGL")=""
|
---|
| 16 | K IO("Q") D ^%ZTLOAD I $D(ZTSK)[0 W !,"Job cancelled!"
|
---|
| 17 | E W !,"REPORT Queued!"
|
---|
| 18 | G EX
|
---|
| 19 | HDR Q:$G(STOP)>0
|
---|
| 20 | W @IOF,!
|
---|
| 21 | W ?SP3,"RELEASE DATA RETURNED SINCE ",$G(SNC)
|
---|
| 22 | W !,?SP,$G(SITENAME)
|
---|
| 23 | W !,?SP1,$G(DAY),!
|
---|
| 24 | W !,"DATE/TIME DATA RETURNED",?36,"Rx's",?44,"ACKNOWLEDGED",! F I=0:1:55 W "="
|
---|
| 25 | W ! S LN=10,STOP=0
|
---|
| 26 | K I
|
---|
| 27 | Q
|
---|
| 28 | ;Called by Taskman to gather data for Release Data Ack msg
|
---|
| 29 | WORK U IO
|
---|
| 30 | D NOW^%DTC S DAY="PRINTED "_$$FMTE^XLFDT(%,"D"),CHK=0 K % S SP1=(54-$L(DAY))/2,SP3=(26-$L(SNC))/2,ACKFG=0
|
---|
| 31 | S SITE=SITE1-1,(ALL1,ALL)=0
|
---|
| 32 | F S SITE=$O(^PSX(554,"AF",SITE)) Q:SITE'>0 D:$G(ALL)>0 TOT S REC=0 F S REC=$O(^PSX(554,"AF",SITE,REC)) Q:REC'>0 D GET
|
---|
| 33 | D:$G(ALL)>0 TOT
|
---|
| 34 | D GRND
|
---|
| 35 | Q
|
---|
| 36 | WORK1 U IO
|
---|
| 37 | ;D NOW^%DTC S DAY="PRINTED "_$$FMTE^XLFDT(%,"D"),CHK=0 K % S SP1=(54-$L(DAY))/2,SP3=(26-$L(SNC))/2,ACKFG=0,X=SITE1,DIC="4",DIC(0)="XZMO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITE=+Y K DIC,Y,X ;****DOD L1
|
---|
| 38 | D NOW^%DTC S DAY="PRINTED "_$$FMTE^XLFDT(%,"D"),CHK=0 K % S SP1=(54-$L(DAY))/2,SP3=(26-$L(SNC))/2,ACKFG=0,X=SITE1,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITE=$$IEN^XUMF(4,AGNCY,X) K DIC,Y,X,AGNCY ;****DOD L1
|
---|
| 39 | S (ALL,REC)=0 F S REC=$O(^PSX(554,"AF",SITE,REC)) Q:REC'>0 D GET
|
---|
| 40 | D TOT,PG
|
---|
| 41 | Q
|
---|
| 42 | GET Q:$G(STOP)>0
|
---|
| 43 | ;S X=SITE,DIC="4",DIC(0)="XMZO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITENAME=$P(Y,"^",2) K X,Y,DIC S SP=(54-$L(SITENAME))/2,ACK=0 ;****DOD L1
|
---|
| 44 | S X=SITE,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITENAME=$$IEN^XUMF(4,AGNCY,X),SITENAME=$$GET1^DIQ(4,SITENAME,.01) K X,Y,AGNCY S SP=(54-$L(SITENAME))/2,ACK=0 ;****DOD L1
|
---|
| 45 | D:$G(IOST)["C-"&($G(LN)>$G(PGL)!(SITE'=CHK)) PG,HDR
|
---|
| 46 | D:$G(IOST)'["C-"&($G(LN)>$G(PGL)!(SITE'=CHK)) HDR
|
---|
| 47 | S:SITE'=CHK ALL=0
|
---|
| 48 | S CHK=SITE
|
---|
| 49 | Q:$G(STOP)>0
|
---|
| 50 | I ($P(^PSX(554,1,3,REC,0),"^",7)="")!($$HTFM^XLFDT(SN,1)<$P($P(^PSX(554,1,3,REC,0),"^"),".")) D
|
---|
| 51 | .S TIME=$$FMTE^XLFDT($P(^PSX(554,1,3,REC,0),"^",1),"1P"),TRX=$P(^PSX(554,1,3,REC,0),"^",6) S ALL2=$G(ALL2)+TRX S:$P(^PSX(554,1,3,REC,0),"^",7)'="" ACK=1,ALL=$G(ALL)+TRX,ALL1=$G(ALL1)+TRX S:$P(^PSX(554,1,3,REC,0),"^",7)="" ACKFG=1
|
---|
| 52 | .S:$G(ACK)="" ACK=0
|
---|
| 53 | .W !,TIME,?30,$J(TRX,10),?48,$S($G(ACK)=0:"NO",$G(ACK)>0:"YES",1:"")
|
---|
| 54 | .K TIME,TRX,ACK
|
---|
| 55 | .S LN=LN+1
|
---|
| 56 | Q
|
---|
| 57 | PG Q:$G(IOST)'["C-"
|
---|
| 58 | Q:$G(STOP)=""
|
---|
| 59 | W ! S DIR(0)="E" D ^DIR K DIR,DIR(0) S:$D(DIRUT) STOP=1 K DIROUT,DTOUT,DUOUT,DIRUT,X,Y Q
|
---|
| 60 | TOT W ! F J=0:1:55 W "="
|
---|
| 61 | W !,"TOTAL",?22,"RETURNED",?40,$J($G(ALL2),10),!,?22,"ACKNOWLEGDED",?40,$J($G(ALL1),10),!,?22,"NOT ACKNOWLEDGED",?40,$J($G(ALL2)-$G(ALL),10)
|
---|
| 62 | S GTOT=$G(GTOT)+$G(ALL2),GNACK=$G(GNACK)+($G(ALL2)-$G(ALL)),GACK=$G(GACK)+$G(ALL1)
|
---|
| 63 | K ALL,ALL2,ALL1
|
---|
| 64 | Q
|
---|
| 65 | GRND W !!,"TOTALS FOR ALL SITES",?22,"RETURNED",?40,$J($G(GTOT),10),!,?22,"ACKNOWLEDGED",?40,$J($G(GACK),10),!,?22,"NOT ACKNOWLEDGED",?40,$J($G(GNACK),10)
|
---|
| 66 | K DIROUT,DTOUT,DUOUT,DIRUT S DIR(0)="E" D ^DIR K DIR,DIR(0)
|
---|
| 67 | K GACK,GNACK,GTOT
|
---|
| 68 | Q
|
---|
| 69 | EX1 W @IOF D ^%ZISC K:$D(IO("Q")) IO("Q") S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 70 | I $G(ACKFG)>0 S DIR(0)="Y",DIR("A")="Resend a Release Message" D ^DIR K DIR G:$D(DIRUT)!($D(DIROUT))!($D(DTOUT))!($D(DUOUT))!($G(Y)=0) EX D:$G(Y)>0&($G(SS)'>0) EN^PSXVCK1 D:$G(Y)>0&($G(SS)>0) EN1^PSXVCK1
|
---|
| 71 | EX K DIC,DIC(0),DIC("A"),X,Y,XX,SITE,SITENAME,REC,DTOUT,DUOUT,CHK,SP,SP1,LN,I,DAY,TIME,TRX,STOP,ALL,ALL1,SS,SNC,SN,ALL2,SITE1
|
---|
| 72 | K ZTDESC,ZTRTN,ZTSAVE("SITE"),ZTSAVE("SITENAME"),%ZIS,ACK,J,ZTQUEUED,ZTDTH,DIR,DIR(0),DIR("A"),DIR("B"),SP3,ACKFG,XXZ,GTOT,GACK,GNACK,ZTSAVE("PGL")
|
---|
| 73 | Q
|
---|