PSXVCK ;BIR/WPB-Routine to check for Release Data Ack MSG ;10/23/98 1:06 PM
;;2.0;CMOP;**19,38**;11 Apr 97
EN Q:'$D(^PSX(554,"AF"))
S DIC="^PSX(552,",DIC(0)="AEQMZ",DIC("A")="Select Facility or RETURN for all: "
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
S:$G(SITE1)'>0 SITE1=0
;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
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
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)
DEV S %ZIS="Q" D ^%ZIS S PGL=($G(IOSL)-2) I POP W !,"No Device Selected!" G EX
I $D(IO("Q")) D QUE Q
I $G(SITE1)=0 D WORK
I $G(SITE1)>0 D WORK1
G EX1
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")=""
K IO("Q") D ^%ZTLOAD I $D(ZTSK)[0 W !,"Job cancelled!"
E W !,"REPORT Queued!"
G EX
HDR Q:$G(STOP)>0
W @IOF,!
W ?SP3,"RELEASE DATA RETURNED SINCE ",$G(SNC)
W !,?SP,$G(SITENAME)
W !,?SP1,$G(DAY),!
W !,"DATE/TIME DATA RETURNED",?36,"Rx's",?44,"ACKNOWLEDGED",! F I=0:1:55 W "="
W ! S LN=10,STOP=0
K I
Q
;Called by Taskman to gather data for Release Data Ack msg
WORK U IO
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
S SITE=SITE1-1,(ALL1,ALL)=0
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
D:$G(ALL)>0 TOT
D GRND
Q
WORK1 U IO
;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
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
S (ALL,REC)=0 F S REC=$O(^PSX(554,"AF",SITE,REC)) Q:REC'>0 D GET
D TOT,PG
Q
GET Q:$G(STOP)>0
;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
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
D:$G(IOST)["C-"&($G(LN)>$G(PGL)!(SITE'=CHK)) PG,HDR
D:$G(IOST)'["C-"&($G(LN)>$G(PGL)!(SITE'=CHK)) HDR
S:SITE'=CHK ALL=0
S CHK=SITE
Q:$G(STOP)>0
I ($P(^PSX(554,1,3,REC,0),"^",7)="")!($$HTFM^XLFDT(SN,1)<$P($P(^PSX(554,1,3,REC,0),"^"),".")) D
.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
.S:$G(ACK)="" ACK=0
.W !,TIME,?30,$J(TRX,10),?48,$S($G(ACK)=0:"NO",$G(ACK)>0:"YES",1:"")
.K TIME,TRX,ACK
.S LN=LN+1
Q
PG Q:$G(IOST)'["C-"
Q:$G(STOP)=""
W ! S DIR(0)="E" D ^DIR K DIR,DIR(0) S:$D(DIRUT) STOP=1 K DIROUT,DTOUT,DUOUT,DIRUT,X,Y Q
TOT W ! F J=0:1:55 W "="
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)
S GTOT=$G(GTOT)+$G(ALL2),GNACK=$G(GNACK)+($G(ALL2)-$G(ALL)),GACK=$G(GACK)+$G(ALL1)
K ALL,ALL2,ALL1
Q
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)
K DIROUT,DTOUT,DUOUT,DIRUT S DIR(0)="E" D ^DIR K DIR,DIR(0)
K GACK,GNACK,GTOT
Q
EX1 W @IOF D ^%ZISC K:$D(IO("Q")) IO("Q") S:$D(ZTQUEUED) ZTREQ="@"
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
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
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")
Q
PSXVCK ;BIR/WPB-Routine to check for Release Data Ack MSG ;10/23/98 1:06 PM
+1 ;;2.0;CMOP;**19,38**;11 Apr 97
EN IF '$DATA(^PSX(554,"AF"))
QUIT
+1 SET DIC="^PSX(552,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Facility or RETURN for all: "
+2 DO ^DIC
KILL DIC
IF $DATA(DUOUT)!($DATA(DTOUT))!(X["^")
GOTO EX
SET SITE1=$PIECE($GET(Y),"^",2)
KILL Y,X,DIC,DIC("A"),DIC(0),DUOUT,DTOUT
+3 IF $GET(SITE1)'>0
SET SITE1=0
+4 ;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
+5 ;****DOD L1
IF $GET(SITE1)>0
SET SS=SITE1
SET X=SITE1
SET AGNCY="VASTANUM"
IF $DATA(^PSX(552,"D",X))
SET X=$EXTRACT(X,2,99)
SET AGNCY="DMIS"
SET Y=$$IEN^XUMF(4,AGNCY,X)
SET SITENAME=$$GET1^DIQ(4,Y,.01)
KILL XX,X,Y,DIC,AGNCY
SET SP=(54-$LENGTH(SITENAME))/2
+6 SET XXZ=$ORDER(^PSX(554,"AS",""))
IF $GET(XXZ)'>0
SET SN=$$HADD^XLFDT($HOROLOG,-14,0,0,0)
IF $GET(XXZ)>0
SET SN=$$HADD^XLFDT($HOROLOG,-$PIECE(^PSX(554,1,1,XXZ,0),"^",8),0,0,0)
IF $GET(SN)'=""
SET SNC=$PIECE($$HTE^XLFDT(SN),"@",1)
DEV SET %ZIS="Q"
DO ^%ZIS
SET PGL=($GET(IOSL)-2)
IF POP
WRITE !,"No Device Selected!"
GOTO EX
+1 IF $DATA(IO("Q"))
DO QUE
QUIT
+2 IF $GET(SITE1)=0
DO WORK
+3 IF $GET(SITE1)>0
DO WORK1
+4 GOTO EX1
QUE IF $DATA(IO("Q"))
SET ZTRTN=$SELECT($GET">GET(SITE1)'>0:"WORK^PSXVCK",$GET">GET(SITE1)>0:"WORK1^PSXVCK",1:"")
SET ZTDESC="CMOP Rx Release Summary"
SET ZTDTH=""
SET ZTSAVE("SNC")=""
SET ZTSAVE("SITE1")=""
SET ZTSAVE("SITENAME")=""
SET ZTSAVE("SN")=""
SET ZTSAVE("PGL")=""
+1 KILL IO("Q")
DO ^%ZTLOAD
IF $DATA(ZTSK)[0
WRITE !,"Job cancelled!"
+2 IF '$TEST
WRITE !,"REPORT Queued!"
+3 GOTO EX
HDR IF $GET(STOP)>0
QUIT
+1 WRITE @IOF,!
+2 WRITE ?SP3,"RELEASE DATA RETURNED SINCE ",$GET(SNC)
+3 WRITE !,?SP,$GET(SITENAME)
+4 WRITE !,?SP1,$GET(DAY),!
+5 WRITE !,"DATE/TIME DATA RETURNED",?36,"Rx's",?44,"ACKNOWLEDGED",!
FOR I=0:1:55
WRITE "="
+6 WRITE !
SET LN=10
SET STOP=0
+7 KILL I
+8 QUIT
+9 ;Called by Taskman to gather data for Release Data Ack msg
WORK USE IO
+1 DO NOW^%DTC
SET DAY="PRINTED "_$$FMTE^XLFDT(%,"D")
SET CHK=0
KILL %
SET SP1=(54-$LENGTH(DAY))/2
SET SP3=(26-$LENGTH(SNC))/2
SET ACKFG=0
+2 SET SITE=SITE1-1
SET (ALL1,ALL)=0
+3 FOR
SET SITE=$ORDER(^PSX(554,"AF",SITE))
IF SITE'>0
QUIT
IF $GET(ALL)>0
DO TOT
SET REC=0
FOR
SET REC=$ORDER(^PSX(554,"AF",SITE,REC))
IF REC'>0
QUIT
DO GET
+4 IF $GET(ALL)>0
DO TOT
+5 DO GRND
+6 QUIT
WORK1 USE IO
+1 ;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
+2 ;****DOD L1
DO NOW^%DTC
SET DAY="PRINTED "_$$FMTE^XLFDT(%,"D")
SET CHK=0
KILL %
SET SP1=(54-$LENGTH(DAY))/2
SET SP3=(26-$LENGTH(SNC))/2
SET ACKFG=0
SET X=SITE1
SET AGNCY="VASTANUM"
IF $DATA(^PSX(552,"D",X))
SET X=$EXTRACT(X,2,99)
SET AGNCY="DMIS"
SET SITE=$$IEN^XUMF(4,AGNCY,X)
KILL DIC,Y,X,AGNCY
+3 SET (ALL,REC)=0
FOR
SET REC=$ORDER(^PSX(554,"AF",SITE,REC))
IF REC'>0
QUIT
DO GET
+4 DO TOT
DO PG
+5 QUIT
GET IF $GET(STOP)>0
QUIT
+1 ;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
+2 ;****DOD L1
SET X=SITE
SET AGNCY="VASTANUM"
IF $DATA(^PSX(552,"D",X))
SET X=$EXTRACT(X,2,99)
SET AGNCY="DMIS"
SET SITENAME=$$IEN^XUMF(4,AGNCY,X)
SET SITENAME=$$GET1^DIQ(4,SITENAME,.01)
KILL X,Y,AGNCY
SET SP=(54-$LENGTH(SITENAME))/2
SET ACK=0
+3 IF $GET">GET">GET">GET(IOST)["C-"&($GET">GET">GET">GET(LN)>$GET">GET">GET">GET(PGL)!(SITE'=CHK))
DO PG
DO HDR
+4 IF $GET">GET">GET">GET(IOST)'["C-"&($GET">GET">GET">GET(LN)>$GET">GET">GET">GET(PGL)!(SITE'=CHK))
DO HDR
+5 IF SITE'=CHK
SET ALL=0
+6 SET CHK=SITE
+7 IF $GET(STOP)>0
QUIT
+8 IF ($PIECE(^PSX(554,1,3,REC,0),"^",7)="")!($$HTFM^XLFDT(SN,1)<$PIECE($PIECE(^PSX(554,1,3,REC,0),"^"),"."))
Begin DoDot:1
+9 SET TIME=$$FMTE^XLFDT($PIECE(^PSX(554,1,3,REC,0),"^",1),"1P")
SET TRX=$PIECE(^PSX(554,1,3,REC,0),"^",6)
SET ALL2=$GET(ALL2)+TRX
IF $PIECE(^PSX(554,1,3,REC,0),"^",7)'=""
SET ACK=1
SET ALL=$GET(ALL)+TRX
SET ALL1=$GET(ALL1)+TRX
IF $PIECE(^PSX(554,1,3,REC,0),"^",7)=""
SET ACKFG=1
+10 IF $GET(ACK)=""
SET ACK=0
+11 WRITE !,TIME,?30,$JUSTIFY(TRX,10),?48,$SELECT($GET">GET(ACK)=0:"NO",$GET">GET(ACK)>0:"YES",1:"")
+12 KILL TIME,TRX,ACK
+13 SET LN=LN+1
End DoDot:1
+14 QUIT
PG IF $GET(IOST)'["C-"
QUIT
+1 IF $GET(STOP)=""
QUIT
+2 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR,DIR(0)
IF $DATA(DIRUT)
SET STOP=1
KILL DIROUT,DTOUT,DUOUT,DIRUT,X,Y
QUIT
TOT WRITE !
FOR J=0:1:55
WRITE "="
+1 WRITE !,"TOTAL",?22,"RETURNED",?40,$JUSTIFY($GET">GET">GET">GET">GET">GET">GET">GET(ALL2),10),!,?22,"ACKNOWLEGDED",?40,$JUSTIFY($GET">GET">GET">GET">GET">GET">GET">GET(ALL1),10),!,?22,"NOT ACKNOWLEDGED",?40,$JUSTIFY($GET">GET">GET">GET">GET">GET">GET">GET(ALL2)-$GET">GET">GET">GET">GET">GET">GET">GET(ALL),10)
+2 SET GTOT=$GET">GET(GTOT)+$GET">GET(ALL2)
SET GNACK=$GET">GET">GET">GET(GNACK)+($GET">GET">GET">GET(ALL2)-$GET">GET">GET">GET(ALL))
SET GACK=$GET">GET(GACK)+$GET">GET(ALL1)
+3 KILL ALL,ALL2,ALL1
+4 QUIT
GRND WRITE !!,"TOTALS FOR ALL SITES",?22,"RETURNED",?40,$JUSTIFY($GET">GET">GET">GET(GTOT),10),!,?22,"ACKNOWLEDGED",?40,$JUSTIFY($GET">GET">GET">GET(GACK),10),!,?22,"NOT ACKNOWLEDGED",?40,$JUSTIFY($GET">GET">GET">GET(GNACK),10)
+1 KILL DIROUT,DTOUT,DUOUT,DIRUT
SET DIR(0)="E"
DO ^DIR
KILL DIR,DIR(0)
+2 KILL GACK,GNACK,GTOT
+3 QUIT
EX1 WRITE @IOF
DO ^%ZISC
IF $DATA(IO("Q"))
KILL IO("Q")
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 IF $GET(ACKFG)>0
SET DIR(0)="Y"
SET DIR("A")="Resend a Release Message"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DIROUT))!($DATA(DTOUT))!($DATA(DUOUT))!($GET(Y)=0)
GOTO EX
IF $GET">GET(Y)>0&($GET">GET(SS)'>0)
DO EN^PSXVCK1
IF $GET">GET(Y)>0&($GET">GET(SS)>0)
DO EN1^PSXVCK1
EX KILL 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
+1 KILL 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")
+2 QUIT
