source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXVCK1.m@ 691

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