PSXVCK.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSXVCK   4728     printed  Feb 18, 2025@23:11:47                                                                                                                                                                                                      Page 2

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(SITE1)'>0:"WORK^PSXVCK",$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(IOST)["C-"&($GET(LN)>$GET(PGL)!(SITE'=CHK))

               DO PG

               DO HDR

 +4        if $GET(IOST)'["C-"&($GET(LN)>$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(ACK)=0:"NO",$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(ALL2),10),!,?22,"ACKNOWLEGDED",?40,$JUSTIFY($GET(ALL1),10),!,?22,"NOT ACKNOWLEDGED",?40,$JUSTIFY($GET(ALL2)-$GET(ALL),10)

 +2        SET GTOT=$GET(GTOT)+$GET(ALL2)

           SET GNACK=$GET(GNACK)+($GET(ALL2)-$GET(ALL))

           SET GACK=$GET(GACK)+$GET(ALL1)

 +3        KILL ALL,ALL2,ALL1

 +4        QUIT 

GRND       WRITE !!,"TOTALS FOR ALL SITES",?22,"RETURNED",?40,$JUSTIFY($GET(GTOT),10),!,?22,"ACKNOWLEDGED",?40,$JUSTIFY($GET(GACK),10),!,?22,"NOT ACKNOWLEDGED",?40,$JUSTIFY($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(Y)>0&($GET(SS)'>0)

                   DO EN^PSXVCK1

               if $GET(Y)>0&($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