PSXVCK1 ;BIR/WPB-Routine to check for Release Data Ack MSG ;16 Jul 1999 9:56 AM
;;2.0;CMOP;**19,38,45**;11 Apr 97
EN K ^TMP("PSXVMSG",$J)
I '$D(^PSX(554,"AF")) W !,"All release data has been acknowledged." Q
S DIC="^PSX(552,",DIC(0)="AEQMZ",DIC("A")="Select Facility: "
D ^DIC K DIC G:$D(DUOUT)!($D(DTOUT))!(X["^")!($G(Y)'>0) EX S SITE1=$P($G(Y),"^",2) D KDIR
S:$G(SITE1)'>0 SITE=0
EN1 ;
;I $G(SITE1)>0 S X=SITE1,DIC="4",DIC(0)="XZMO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITENAME=$P(Y,"^",2),SITE=+Y K X,Y,DIC S SP=(40-$L(SITENAME))/2 ;****DOD L1
I $G(SITE1)>0 S X=SITE1,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITE=$$IEN^XUMF(4,AGNCY,X),SITENAME=$$GET1^DIQ(4,SITE,.01) K X,Y,DIC,AGNCY S SP=(40-$L(SITENAME))/2 ;****DOD L1
I $G(SITE)>0&('$D(^PSX(554,"AF",$G(SITE)))) W !,"All release data has been acknowledged for ",$G(SITENAME) Q
D WORK,RPT
I '$D(^TMP("PSXVMSG",$J)) W !,"No Data for the Report!" D PG G EX
D RESET
G EX
QUE S ZTIO="PSX",ZTDTH=TSKTM,ZTRTN="RST^PSXVCK1",ZTDESC="CMOP Release Data Msg Rebuilder",ZTSAVE("REPLY")="" D ^%ZTLOAD
I $G(ZTSK)>0 W !,"Job Started."
G EX
Q
RESET1 W !,"Enter message number or numbers separated by commas" K X
RESET D KDIR K REPLY
W ! S DIR(0)="L^1:"_CNT,DIR("A")="Resend messages",DIR("?")="Enter message number or numbers separated by commas." D ^DIR G:$G(X)["-" RESET1 K DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!($G(Y)'>0) S RPLY=$G(Y)
D KDIR
I $G(RPLY)>0 F R=1:1 S NUM=$P(RPLY,",",R) Q:$G(NUM)'>0 S:$G(REPLY)'="" REPLY=$G(REPLY)_","_$P(^TMP("PSXVMSG",$J,SITE,NUM),"^",3) S:$G(REPLY)="" REPLY=$P(^TMP("PSXVMSG",$J,SITE,NUM),"^",3)
K RPLY,R
S %DT="RASAET",%DT("A")="Enter time: ",%DT(0)="NOW",%DT("B")="NOW" D ^%DT S TSKTM=Y K %DT G:Y<0!($D(DTOUT)) EX D QUE
K REPLY,%,%DT,%DT(0),%DT("A"),%DT("B"),Y,X,RESP,DTOUT
Q
;Called by Taskman to resend release data
RST S RC=$O(^PSX(554,"AB","")) G:$G(RC)'>0 RST1
I $G(RC)>0&($P(^PSX(554,1,1,RC,0),"^",4)="R") S ZTDTH="300S",ZTDESC="CMOP Release Data Msg Rebuilder",ZTRTN="RST^PSXVCK1",ZTIO="PSX",ZTSAVE("REPLY")="" D REQ^%ZTLOAD,EX Q
S ZTREQ="@",$P(^PSX(554,1,1,RC,0),"^",4)="R"
RST1 F I=1:1 S TXMZ=$P(REPLY,",",I) Q:$G(TXMZ)'>0 D SEND
I $G(ZTSK)'>0 W !!,"Messages Resent!!"
G EX
Q
SEND Q:'$D(^PSX(552.4,"AB",TXMZ))
S XX=0 F S XX=$O(^PSX(552.4,"AB",TXMZ,XX)) Q:XX'>0 S ZZ=0 D
.F S ZZ=$O(^PSX(552.4,"AB",TXMZ,XX,ZZ)) Q:ZZ'>0 D
..L +^PSX(552.4,XX,1,ZZ):600
..S DA(1)=XX,DA=ZZ,DIE="^PSX(552.4,"_DA(1)_",1,"
..S DR="9////1;15////@" D ^DIE L -^PSX(552.4,XX,1,ZZ) K DIE,DA,DR
K XX,ZZ
D NOW^%DTC
S OLD=$O(^PSX(554,"AC",TXMZ,"")) Q:$G(OLD)'>0
L +^PSX(554,1,1,OLD):600 S DA=OLD,DA(1)=1,DIE="^PSX(554,"_DA(1)_",3,"
S DR="1////@;6////"_% D ^DIE L -^PSX(554,1,1,OLD)
K DA,DR,DIE,^PSX(554,"AF",$P(^PSX(554,1,3,OLD,0),"^",3),OLD),OLD,TXMZ,%
;S:(RC'="") $P(^PSX(554,1,1,RC,0),"^",4)="S"
Q
HDR Q:$G(STOP)>0
D SITE
W @IOF,!
W ?8,"RELEASE DATA NOT ACKNOWLEDGED"
W !,?SP,$G(SITENAME)
W !,?SP1,$G(DAY),!
W !,"MESSAGE",?10,"DATE/TIME DATA RETURNED",?37,"TOTAL Rx's",! F I=0:1:46 W "="
W ! S LN=10
K I
Q
WORK ;S CNT=$G(CNT)+1 K STOP
K STOP
S REC=0 F S REC=$O(^PSX(554,"AF",SITE,REC)) Q:REC'>0 D GET
Q
SITE S X=FAC,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITENAME=$$IEN^XUMF(4,AGNCY,X),SITENAME=$$NAME^XUAF4(SITENAME) K X,Y,AGNCY S SP=(47-$L(SITENAME))/2 Q ;****DOD L1
GET D NOW^%DTC S TIMECHK=$$FMDIFF^XLFDT(%,$P(^PSX(554,1,3,REC,0),"^"),2)
Q:TIMECHK<86400
Q:$P(^PSX(554,1,3,REC,0),"^",7)'=""
S TIME=$$FMTE^XLFDT($P(^PSX(554,1,3,REC,0),"^",1),"1P"),TRX=$P(^PSX(554,1,3,REC,0),"^",6),MSGN=$P(^PSX(554,1,3,REC,0),"^",2),ACK=$S($P(^PSX(554,1,3,REC,0),"^",4)>0:"1",1:0)
Q:$G(MSGN)'>0
;S:$G(ACK)'>0 ^TMP("PSXVMSG",$J,SITE,CNT)=TIME_"^"_TRX_"^"_$G(MSGN)_"^"_$G(ACK),CNT=CNT+1
S:$G(ACK)'>0 CNT=$G(CNT)+1,^TMP("PSXVMSG",$J,SITE,CNT)=TIME_"^"_TRX_"^"_$G(MSGN)_"^"_$G(ACK)
K TIME,TRX,ACK
Q
RPT Q:'$D(^TMP("PSXVMSG",$J))
D NOW^%DTC S DAY=$$FMTE^XLFDT(%,"D"),SP1=(47-$L(DAY))/2,CHK=0 K %
S FAC=0 F S FAC=$O(^TMP("PSXVMSG",$J,FAC)) Q:FAC'>0 S MSG=0 F S MSG=$O(^TMP("PSXVMSG",$J,FAC,MSG)) Q:MSG'>0 D Q:$G(STOP)>0
.Q:$G(STOP)>0
.D:FAC'=CHK HDR
.D:LN>23 PG,HDR
.Q:$G(STOP)>0
.S NODE=$G(^TMP("PSXVMSG",$J,FAC,MSG))
.S TIME=$P(NODE,"^",1),RXS=$P(NODE,"^",2),ACKD=$P(NODE,"^",4),MSGN=$P(NODE,"^",3)
.I $G(ACKD)'>0 W !,$J(MSG,7),?10,TIME,?37,$J(RXS,10)
.S LN=LN+1
.K NODE,TIME,RXS,ACKD
.S CHK=FAC
Q
PG D KDIR
W ! S DIR(0)="E" D ^DIR K DIR,DIR(0) S:$D(DIRUT) STOP=1 K DIROUT,DTOUT,DUOUT,DIRUT Q
NO D KDIR W ! S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you sure",DIR("A",1)="Data will not be resent." D ^DIR K DIR G:$D(DIRUT)!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) NO1 D:$G(Y)'>0 RESET
NO1 W !,"No data was resent." G EX1
Q
EX I '$D(ZTSK) W @IOF
I '$G(RC)>0 S RC=$O(^PSX(554,"AB","")) S:$G(RC)>0 $P(^PSX(554,1,1,RC,0),"^",4)="S"
EX1 K XX,SITE,SITENAME,CHK,SP,SP1,LN,I,DAY,TIME,TRX,STOP,MSG,MSGN,FAC,NODE,RXS,REPLY,CNT,REC
K ^TMP("PSXVMSG",$J),TIMECHK,CKR,CKR1,NUM,OLD,NODE
K ZTIO,ZTDTH,ZTRTN,ZTDESC,ZTSAVE("REPLY"),ZTSAVE("TSKTM"),RX,TSKTM,RC,RESP
KDIR K DIRUT,DIROUT,DIR,DIR(0),DIR("A"),DIR("B"),X,Y,DTOUT,DUOUT,DIC,DIC("A"),DIC(0),DUOUT,DTOUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXVCK1 5255 printed Dec 13, 2024@01:45:25 Page 2
PSXVCK1 ;BIR/WPB-Routine to check for Release Data Ack MSG ;16 Jul 1999 9:56 AM
+1 ;;2.0;CMOP;**19,38,45**;11 Apr 97
EN KILL ^TMP("PSXVMSG",$JOB)
+1 IF '$DATA(^PSX(554,"AF"))
WRITE !,"All release data has been acknowledged."
QUIT
+2 SET DIC="^PSX(552,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Facility: "
+3 DO ^DIC
KILL DIC
if $DATA(DUOUT)!($DATA(DTOUT))!(X["^")!($GET(Y)'>0)
GOTO EX
SET SITE1=$PIECE($GET(Y),"^",2)
DO KDIR
+4 if $GET(SITE1)'>0
SET SITE=0
EN1 ;
+1 ;I $G(SITE1)>0 S X=SITE1,DIC="4",DIC(0)="XZMO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITENAME=$P(Y,"^",2),SITE=+Y K X,Y,DIC S SP=(40-$L(SITENAME))/2 ;****DOD L1
+2 ;****DOD L1
IF $GET(SITE1)>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)
SET SITENAME=$$GET1^DIQ(4,SITE,.01)
KILL X,Y,DIC,AGNCY
SET SP=(40-$LENGTH(SITENAME))/2
+3 IF $GET(SITE)>0&('$DATA(^PSX(554,"AF",$GET(SITE))))
WRITE !,"All release data has been acknowledged for ",$GET(SITENAME)
QUIT
+4 DO WORK
DO RPT
+5 IF '$DATA(^TMP("PSXVMSG",$JOB))
WRITE !,"No Data for the Report!"
DO PG
GOTO EX
+6 DO RESET
+7 GOTO EX
QUE SET ZTIO="PSX"
SET ZTDTH=TSKTM
SET ZTRTN="RST^PSXVCK1"
SET ZTDESC="CMOP Release Data Msg Rebuilder"
SET ZTSAVE("REPLY")=""
DO ^%ZTLOAD
+1 IF $GET(ZTSK)>0
WRITE !,"Job Started."
+2 GOTO EX
+3 QUIT
RESET1 WRITE !,"Enter message number or numbers separated by commas"
KILL X
RESET DO KDIR
KILL REPLY
+1 WRITE !
SET DIR(0)="L^1:"_CNT
SET DIR("A")="Resend messages"
SET DIR("?")="Enter message number or numbers separated by commas."
DO ^DIR
if $GET(X)["-"
GOTO RESET1
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))!($GET(Y)'>0)
QUIT
SET RPLY=$GET(Y)
+2 DO KDIR
+3 IF $GET(RPLY)>0
FOR R=1:1
SET NUM=$PIECE(RPLY,",",R)
if $GET(NUM)'>0
QUIT
if $GET(REPLY)'=""
SET REPLY=$GET(REPLY)_","_$PIECE(^TMP("PSXVMSG",$JOB,SITE,NUM),"^",3)
if $GET(REPLY)=""
SET REPLY=$PIECE(^TMP("PSXVMSG",$JOB,SITE,NUM),"^",3)
+4 KILL RPLY,R
+5 SET %DT="RASAET"
SET %DT("A")="Enter time: "
SET %DT(0)="NOW"
SET %DT("B")="NOW"
DO ^%DT
SET TSKTM=Y
KILL %DT
if Y<0!($DATA(DTOUT))
GOTO EX
DO QUE
+6 KILL REPLY,%,%DT,%DT(0),%DT("A"),%DT("B"),Y,X,RESP,DTOUT
+7 QUIT
+8 ;Called by Taskman to resend release data
RST SET RC=$ORDER(^PSX(554,"AB",""))
if $GET(RC)'>0
GOTO RST1
+1 IF $GET(RC)>0&($PIECE(^PSX(554,1,1,RC,0),"^",4)="R")
SET ZTDTH="300S"
SET ZTDESC="CMOP Release Data Msg Rebuilder"
SET ZTRTN="RST^PSXVCK1"
SET ZTIO="PSX"
SET ZTSAVE("REPLY")=""
DO REQ^%ZTLOAD
DO EX
QUIT
+2 SET ZTREQ="@"
SET $PIECE(^PSX(554,1,1,RC,0),"^",4)="R"
RST1 FOR I=1:1
SET TXMZ=$PIECE(REPLY,",",I)
if $GET(TXMZ)'>0
QUIT
DO SEND
+1 IF $GET(ZTSK)'>0
WRITE !!,"Messages Resent!!"
+2 GOTO EX
+3 QUIT
SEND if '$DATA(^PSX(552.4,"AB",TXMZ))
QUIT
+1 SET XX=0
FOR
SET XX=$ORDER(^PSX(552.4,"AB",TXMZ,XX))
if XX'>0
QUIT
SET ZZ=0
Begin DoDot:1
+2 FOR
SET ZZ=$ORDER(^PSX(552.4,"AB",TXMZ,XX,ZZ))
if ZZ'>0
QUIT
Begin DoDot:2
+3 LOCK +^PSX(552.4,XX,1,ZZ):600
+4 SET DA(1)=XX
SET DA=ZZ
SET DIE="^PSX(552.4,"_DA(1)_",1,"
+5 SET DR="9////1;15////@"
DO ^DIE
LOCK -^PSX(552.4,XX,1,ZZ)
KILL DIE,DA,DR
End DoDot:2
End DoDot:1
+6 KILL XX,ZZ
+7 DO NOW^%DTC
+8 SET OLD=$ORDER(^PSX(554,"AC",TXMZ,""))
if $GET(OLD)'>0
QUIT
+9 LOCK +^PSX(554,1,1,OLD):600
SET DA=OLD
SET DA(1)=1
SET DIE="^PSX(554,"_DA(1)_",3,"
+10 SET DR="1////@;6////"_%
DO ^DIE
LOCK -^PSX(554,1,1,OLD)
+11 KILL DA,DR,DIE,^PSX(554,"AF",$PIECE(^PSX(554,1,3,OLD,0),"^",3),OLD),OLD,TXMZ,%
+12 ;S:(RC'="") $P(^PSX(554,1,1,RC,0),"^",4)="S"
+13 QUIT
HDR if $GET(STOP)>0
QUIT
+1 DO SITE
+2 WRITE @IOF,!
+3 WRITE ?8,"RELEASE DATA NOT ACKNOWLEDGED"
+4 WRITE !,?SP,$GET(SITENAME)
+5 WRITE !,?SP1,$GET(DAY),!
+6 WRITE !,"MESSAGE",?10,"DATE/TIME DATA RETURNED",?37,"TOTAL Rx's",!
FOR I=0:1:46
WRITE "="
+7 WRITE !
SET LN=10
+8 KILL I
+9 QUIT
WORK ;S CNT=$G(CNT)+1 K STOP
+1 KILL STOP
+2 SET REC=0
FOR
SET REC=$ORDER(^PSX(554,"AF",SITE,REC))
if REC'>0
QUIT
DO GET
+3 QUIT
SITE ;****DOD L1
SET X=FAC
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=$$NAME^XUAF4(SITENAME)
KILL X,Y,AGNCY
SET SP=(47-$LENGTH(SITENAME))/2
QUIT
GET DO NOW^%DTC
SET TIMECHK=$$FMDIFF^XLFDT(%,$PIECE(^PSX(554,1,3,REC,0),"^"),2)
+1 if TIMECHK<86400
QUIT
+2 if $PIECE(^PSX(554,1,3,REC,0),"^",7)'=""
QUIT
+3 SET TIME=$$FMTE^XLFDT($PIECE(^PSX(554,1,3,REC,0),"^",1),"1P")
SET TRX=$PIECE(^PSX(554,1,3,REC,0),"^",6)
SET MSGN=$PIECE(^PSX(554,1,3,REC,0),"^",2)
SET ACK=$SELECT($PIECE(^PSX(554,1,3,REC,0),"^",4)>0:"1",1:0)
+4 if $GET(MSGN)'>0
QUIT
+5 ;S:$G(ACK)'>0 ^TMP("PSXVMSG",$J,SITE,CNT)=TIME_"^"_TRX_"^"_$G(MSGN)_"^"_$G(ACK),CNT=CNT+1
+6 if $GET(ACK)'>0
SET CNT=$GET(CNT)+1
SET ^TMP("PSXVMSG",$JOB,SITE,CNT)=TIME_"^"_TRX_"^"_$GET(MSGN)_"^"_$GET(ACK)
+7 KILL TIME,TRX,ACK
+8 QUIT
RPT if '$DATA(^TMP("PSXVMSG",$JOB))
QUIT
+1 DO NOW^%DTC
SET DAY=$$FMTE^XLFDT(%,"D")
SET SP1=(47-$LENGTH(DAY))/2
SET CHK=0
KILL %
+2 SET FAC=0
FOR
SET FAC=$ORDER(^TMP("PSXVMSG",$JOB,FAC))
if FAC'>0
QUIT
SET MSG=0
FOR
SET MSG=$ORDER(^TMP("PSXVMSG",$JOB,FAC,MSG))
if MSG'>0
QUIT
Begin DoDot:1
+3 if $GET(STOP)>0
QUIT
+4 if FAC'=CHK
DO HDR
+5 if LN>23
DO PG
DO HDR
+6 if $GET(STOP)>0
QUIT
+7 SET NODE=$GET(^TMP("PSXVMSG",$JOB,FAC,MSG))
+8 SET TIME=$PIECE(NODE,"^",1)
SET RXS=$PIECE(NODE,"^",2)
SET ACKD=$PIECE(NODE,"^",4)
SET MSGN=$PIECE(NODE,"^",3)
+9 IF $GET(ACKD)'>0
WRITE !,$JUSTIFY(MSG,7),?10,TIME,?37,$JUSTIFY(RXS,10)
+10 SET LN=LN+1
+11 KILL NODE,TIME,RXS,ACKD
+12 SET CHK=FAC
End DoDot:1
if $GET(STOP)>0
QUIT
+13 QUIT
PG DO KDIR
+1 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR,DIR(0)
if $DATA(DIRUT)
SET STOP=1
KILL DIROUT,DTOUT,DUOUT,DIRUT
QUIT
NO DO KDIR
WRITE !
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Are you sure"
SET DIR("A",1)="Data will not be resent."
DO ^DIR
KILL DIR
if $DATA(DIRUT)!($DATA(DIROUT))!($DATA(DTOUT))!($DATA(DUOUT))
GOTO NO1
if $GET(Y)'>0
DO RESET
NO1 WRITE !,"No data was resent."
GOTO EX1
+1 QUIT
EX IF '$DATA(ZTSK)
WRITE @IOF
+1 IF '$GET(RC)>0
SET RC=$ORDER(^PSX(554,"AB",""))
if $GET(RC)>0
SET $PIECE(^PSX(554,1,1,RC,0),"^",4)="S"
EX1 KILL XX,SITE,SITENAME,CHK,SP,SP1,LN,I,DAY,TIME,TRX,STOP,MSG,MSGN,FAC,NODE,RXS,REPLY,CNT,REC
+1 KILL ^TMP("PSXVMSG",$JOB),TIMECHK,CKR,CKR1,NUM,OLD,NODE
+2 KILL ZTIO,ZTDTH,ZTRTN,ZTDESC,ZTSAVE("REPLY"),ZTSAVE("TSKTM"),RX,TSKTM,RC,RESP
KDIR KILL DIRUT,DIROUT,DIR,DIR(0),DIR("A"),DIR("B"),X,Y,DTOUT,DUOUT,DIC,DIC("A"),DIC(0),DUOUT,DTOUT
+1 QUIT
