- 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
- 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">GET(SITE)>0&('$DATA(^PSX(554,"AF",$GET">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">GET(MSGN)_"^"_$GET">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
