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

Last change on this file since 1523 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.0 KB
RevLine 
[613]1PSXVCK1 ;BIR/WPB-Routine to check for Release Data Ack MSG ;16 Jul 1999 9:56 AM
2 ;;2.0;CMOP;**19,38,45**;11 Apr 97
3EN K ^TMP("PSXVMSG",$J)
4 I '$D(^PSX(554,"AF")) W !,"All release data has been acknowledged." Q
5 S DIC="^PSX(552,",DIC(0)="AEQMZ",DIC("A")="Select Facility: "
6 D ^DIC K DIC G:$D(DUOUT)!($D(DTOUT))!(X["^")!($G(Y)'>0) EX S SITE1=$P($G(Y),"^",2) D KDIR
7 S:$G(SITE1)'>0 SITE=0
8EN1 ;
9 ;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
10 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
11 I $G(SITE)>0&('$D(^PSX(554,"AF",$G(SITE)))) W !,"All release data has been acknowledged for ",$G(SITENAME) Q
12 D WORK,RPT
13 I '$D(^TMP("PSXVMSG",$J)) W !,"No Data for the Report!" D PG G EX
14 D RESET
15 G EX
16QUE S ZTIO="PSX",ZTDTH=TSKTM,ZTRTN="RST^PSXVCK1",ZTDESC="CMOP Release Data Msg Rebuilder",ZTSAVE("REPLY")="" D ^%ZTLOAD
17 I $G(ZTSK)>0 W !,"Job Started."
18 G EX
19 Q
20RESET1 W !,"Enter message number or numbers separated by commas" K X
21RESET D KDIR K REPLY
22 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)
23 D KDIR
24 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)
25 K RPLY,R
26 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
27 K REPLY,%,%DT,%DT(0),%DT("A"),%DT("B"),Y,X,RESP,DTOUT
28 Q
29 ;Called by Taskman to resend release data
30RST S RC=$O(^PSX(554,"AB","")) G:$G(RC)'>0 RST1
31 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
32 S ZTREQ="@",$P(^PSX(554,1,1,RC,0),"^",4)="R"
33RST1 F I=1:1 S TXMZ=$P(REPLY,",",I) Q:$G(TXMZ)'>0 D SEND
34 I $G(ZTSK)'>0 W !!,"Messages Resent!!"
35 G EX
36 Q
37SEND Q:'$D(^PSX(552.4,"AB",TXMZ))
38 S XX=0 F S XX=$O(^PSX(552.4,"AB",TXMZ,XX)) Q:XX'>0 S ZZ=0 D
39 .F S ZZ=$O(^PSX(552.4,"AB",TXMZ,XX,ZZ)) Q:ZZ'>0 D
40 ..L +^PSX(552.4,XX,1,ZZ):600
41 ..S DA(1)=XX,DA=ZZ,DIE="^PSX(552.4,"_DA(1)_",1,"
42 ..S DR="9////1;15////@" D ^DIE L -^PSX(552.4,XX,1,ZZ) K DIE,DA,DR
43 K XX,ZZ
44 D NOW^%DTC
45 S OLD=$O(^PSX(554,"AC",TXMZ,"")) Q:$G(OLD)'>0
46 L +^PSX(554,1,1,OLD):600 S DA=OLD,DA(1)=1,DIE="^PSX(554,"_DA(1)_",3,"
47 S DR="1////@;6////"_% D ^DIE L -^PSX(554,1,1,OLD)
48 K DA,DR,DIE,^PSX(554,"AF",$P(^PSX(554,1,3,OLD,0),"^",3),OLD),OLD,TXMZ,%
49 ;S:(RC'="") $P(^PSX(554,1,1,RC,0),"^",4)="S"
50 Q
51HDR Q:$G(STOP)>0
52 D SITE
53 W @IOF,!
54 W ?8,"RELEASE DATA NOT ACKNOWLEDGED"
55 W !,?SP,$G(SITENAME)
56 W !,?SP1,$G(DAY),!
57 W !,"MESSAGE",?10,"DATE/TIME DATA RETURNED",?37,"TOTAL Rx's",! F I=0:1:46 W "="
58 W ! S LN=10
59 K I
60 Q
61WORK ;S CNT=$G(CNT)+1 K STOP
62 K STOP
63 S REC=0 F S REC=$O(^PSX(554,"AF",SITE,REC)) Q:REC'>0 D GET
64 Q
65SITE 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
66GET D NOW^%DTC S TIMECHK=$$FMDIFF^XLFDT(%,$P(^PSX(554,1,3,REC,0),"^"),2)
67 Q:TIMECHK<86400
68 Q:$P(^PSX(554,1,3,REC,0),"^",7)'=""
69 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)
70 Q:$G(MSGN)'>0
71 ;S:$G(ACK)'>0 ^TMP("PSXVMSG",$J,SITE,CNT)=TIME_"^"_TRX_"^"_$G(MSGN)_"^"_$G(ACK),CNT=CNT+1
72 S:$G(ACK)'>0 CNT=$G(CNT)+1,^TMP("PSXVMSG",$J,SITE,CNT)=TIME_"^"_TRX_"^"_$G(MSGN)_"^"_$G(ACK)
73 K TIME,TRX,ACK
74 Q
75RPT Q:'$D(^TMP("PSXVMSG",$J))
76 D NOW^%DTC S DAY=$$FMTE^XLFDT(%,"D"),SP1=(47-$L(DAY))/2,CHK=0 K %
77 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
78 .Q:$G(STOP)>0
79 .D:FAC'=CHK HDR
80 .D:LN>23 PG,HDR
81 .Q:$G(STOP)>0
82 .S NODE=$G(^TMP("PSXVMSG",$J,FAC,MSG))
83 .S TIME=$P(NODE,"^",1),RXS=$P(NODE,"^",2),ACKD=$P(NODE,"^",4),MSGN=$P(NODE,"^",3)
84 .I $G(ACKD)'>0 W !,$J(MSG,7),?10,TIME,?37,$J(RXS,10)
85 .S LN=LN+1
86 .K NODE,TIME,RXS,ACKD
87 .S CHK=FAC
88 Q
89PG D KDIR
90 W ! S DIR(0)="E" D ^DIR K DIR,DIR(0) S:$D(DIRUT) STOP=1 K DIROUT,DTOUT,DUOUT,DIRUT Q
91NO 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
92NO1 W !,"No data was resent." G EX1
93 Q
94EX I '$D(ZTSK) W @IOF
95 I '$G(RC)>0 S RC=$O(^PSX(554,"AB","")) S:$G(RC)>0 $P(^PSX(554,1,1,RC,0),"^",4)="S"
96EX1 K XX,SITE,SITENAME,CHK,SP,SP1,LN,I,DAY,TIME,TRX,STOP,MSG,MSGN,FAC,NODE,RXS,REPLY,CNT,REC
97 K ^TMP("PSXVMSG",$J),TIMECHK,CKR,CKR1,NUM,OLD,NODE
98 K ZTIO,ZTDTH,ZTRTN,ZTDESC,ZTSAVE("REPLY"),ZTSAVE("TSKTM"),RX,TSKTM,RC,RESP
99KDIR K DIRUT,DIROUT,DIR,DIR(0),DIR("A"),DIR("B"),X,Y,DTOUT,DUOUT,DIC,DIC("A"),DIC(0),DUOUT,DTOUT
100 Q
Note: See TracBrowser for help on using the repository browser.