| 1 | PSXRPPL1 ;BIR/WPB-Resets Suspense to Print/Transmit ;[ 10/02/97 3:13 PM ]
|
|---|
| 2 | ;;2.0;CMOP;**3,48,62**;11 Apr 97;Build 12
|
|---|
| 3 | ;Reference to ^PSRX( supported by DBIA #1977
|
|---|
| 4 | ;Reference to File #59 supported by DBIA #1976
|
|---|
| 5 | ;Reference to PSOSURST supported by DBIA #1970
|
|---|
| 6 | ;Reference to ^PS(52.5, supported by DBIA #1978
|
|---|
| 7 | ;Reference to ^BPSUTIL supported by DBIA #4410
|
|---|
| 8 | ;Reference to ^PSSLOCK supported by DBIA #2789
|
|---|
| 9 | ;Reference to ^PSOBPSUT supported by DBIA #4701
|
|---|
| 10 | ;Reference to ^PSOBPSU1 supported by DBIA #4702
|
|---|
| 11 | ;Reference to ^PSOREJUT supported by DBIA #4706
|
|---|
| 12 | ;
|
|---|
| 13 | ;This routine will reset the Queued flags and the printed flags in
|
|---|
| 14 | ;PS(52.5 to 'Queued' and 'Printed' respectively and either retransmits
|
|---|
| 15 | ;the data to the CMOP or prints the labels.
|
|---|
| 16 | START ;initializes local variables
|
|---|
| 17 | I '$D(^XUSEC("PSXCMOPMGR",DUZ)) W !,"You are not authorized to use this option!" Q
|
|---|
| 18 | I '$D(^XUSEC("PSX XMIT",DUZ)) W !,"You are not authorized to use this option!" Q
|
|---|
| 19 | S SWITCH=0
|
|---|
| 20 | K ^TMP($J,"PSX")
|
|---|
| 21 | QRY ;initial message and option menu
|
|---|
| 22 | W !
|
|---|
| 23 | S DIR(0)="NAO^1:3:0",DIR("A")="Select (1, 2, 3): ",DIR("A",1)=" 1 - Reset CMOP Batches for Transmission"
|
|---|
| 24 | S DIR("A",2)=" 2 - Reprint CMOP Batches",DIR("A",4)=" 3 - Standard Reprint Batches from Suspense"
|
|---|
| 25 | S DIR("?")="Enter a number between 1 and 3.",DIR("??")=$S($G(PSXVER):"^D HELP^PSXSRP",1:"^D MSG2^PSXRHLP") D ^DIR K DIR G:(Y<0)!($D(DIRUT)) EXIT S REPLY=Y K Y,X
|
|---|
| 26 | I REPLY=1 S (PSXTRANS,PSXFLAG,SWITCH)=1 G:$G(PSXVER) ^PSXSRST G:'$G(PSXVER) BEGIN
|
|---|
| 27 | I REPLY=2 S (PSXTRANS,PSXFLAG,SWITCH)=2 G:$G(PSXVER) ^PSXSRST G:'$G(PSXVER) BEGIN
|
|---|
| 28 | I REPLY=3 S PSXFLG=1 G START^PSOSURST
|
|---|
| 29 | K REPLY
|
|---|
| 30 | Q
|
|---|
| 31 | BEGIN ;confirms CMOP processing, if Yes, checks for active site and status
|
|---|
| 32 | ;in the CMOP System file, if not an active site or the system status
|
|---|
| 33 | ;is not stopped the routine exits and processing stops
|
|---|
| 34 | W !
|
|---|
| 35 | S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to continue",DIR("?",1)="No - Exits."
|
|---|
| 36 | S DIR("?")=$S(SWITCH=1:"Yes - Transmits data to the CMOP.",SWITCH=2:"Yes - Prints labels.",1:0) D ^DIR K DIR G:(Y=0)!($D(DIRUT)) EXIT K Y
|
|---|
| 37 | S STATUS=$P($G(^PSX(550,+PSXSYS,0)),"^",3) I STATUS'="H" W !,"There is another job in process, please try again later." G EXIT
|
|---|
| 38 | ASK ;gets date for the resets
|
|---|
| 39 | K BEGDATE,ENDDATE W !!,?10,$S($G(SWITCH)=1:"RESET and TRANSMIT CMOP DATA",$G(SWITCH)=2:"RESET and REPRINT CMOP LABELS",1:""),!!!,"**** Date Selection ****",!!
|
|---|
| 40 | ASK1 I SWITCH=1 S %DT="AEX",%DT("A")=" BEGIN DATE: " D ^%DT K %DT,%DT("A") G:Y<0 EXIT S PRTDT=Y
|
|---|
| 41 | I SWITCH=2 S %DT="AEX",%DT("A")=" BEGIN DATE: " D ^%DT K %DT,%DT("A") G:Y<0 EXIT S PRTDT=Y
|
|---|
| 42 | W !! S %DT="AEX",%DT("A")=" ENDING DATE: " D ^%DT Q:Y<0 S PSXDTRG=Y K %DT,%DT("A")
|
|---|
| 43 | I $G(PRTDT)>$G(PSXDTRG) W !,"Begin Date must be before Ending Date!" G ASK1
|
|---|
| 44 | I '$O(^PS(52.5,"AP",PRTDT-1))!($O(^(0))>PSXDTRG) W !!,$S(SWITCH=1:"Nothing to Transmit.",SWITCH=2:"Nothing to Reprint.",1:0) G EXIT
|
|---|
| 45 | D SDT S PSXERFLG=0
|
|---|
| 46 | I SWITCH=1 D PSXTRANS Q
|
|---|
| 47 | I SWITCH=2 D PRINT Q
|
|---|
| 48 | S PSXSTAT="H" D PSXSTAT^PSXRSYU
|
|---|
| 49 | G EXIT
|
|---|
| 50 | PSXTRANS ;
|
|---|
| 51 | W !!
|
|---|
| 52 | S DIR(0)="Y",DIR("B")="YES",DIR("A")="DO YOU WISH TO TRANSMIT TO THE CMOP NOW",DIR("?",1)="No - Exits the option.",DIR("?")="Yes - Transmits to the CMOP." D ^DIR K DIR Q:(Y=0)!($D(DIRUT)) K Y
|
|---|
| 53 | S PSXSTAT="T" D PSXSTAT^PSXRSYU,ASK^PSXRSUS
|
|---|
| 54 | Q
|
|---|
| 55 | PRINT ;
|
|---|
| 56 | W !!
|
|---|
| 57 | S DIR(0)="Y",DIR("B")="YES",DIR("A")="DO YOU WISH REPRINT CMOP LABELS NOW",DIR("?",1)="No - Exits the option.",DIR("?")="Yes - Reprints CMOP labels." D ^DIR K DIR Q:(Y=0)!($D(DIRUT)) K Y
|
|---|
| 58 | S PSXSTAT="T" D PSXSTAT^PSXRSYU,ASK^PSXRSUS
|
|---|
| 59 | Q
|
|---|
| 60 | SDT ;the following subroutines go through the PS(52.5 global and pull the
|
|---|
| 61 | ;data needed to reset the Queued/Printed nodes
|
|---|
| 62 | S SDT=PRTDT-1 F S SDT=$O(^PS(52.5,"AP",SDT)),DFN=0 Q:(SDT>PSXDTRG)!(SDT="") D DFN
|
|---|
| 63 | Q
|
|---|
| 64 | DFN ;
|
|---|
| 65 | F S DFN=$O(^PS(52.5,"AP",SDT,DFN)),REC=0 Q:(DFN="")!(DFN'>0) D REC
|
|---|
| 66 | Q
|
|---|
| 67 | REC ;
|
|---|
| 68 | F S REC=$O(^PS(52.5,"AP",SDT,DFN,REC)) Q:(REC'>0)!(REC="") D:$G(^PS(52.5,REC,0)) CHECK
|
|---|
| 69 | K ZDIV
|
|---|
| 70 | Q
|
|---|
| 71 | CHECK ;
|
|---|
| 72 | S STAT=$P($G(^PS(52.5,REC,0)),U,7),PRINT=$G(^PS(52.5,REC,"P")),PSXPTR=$P($G(^PS(52.5,REC,0)),U,1)
|
|---|
| 73 | S RXF="" F XXF=0:0 S XXF=$O(^PSRX(PSXPTR,1,XXF)) Q:XXF'>0 S RXF=XXF
|
|---|
| 74 | S ZDIV=$S($G(RXF)>0:$P($G(^PSRX(PSXPTR,1,RXF,0)),U,9),1:$P($G(^PSRX(PSXPTR,2)),U,9)) I $G(ZDIV)'=$G(PSOSITE) Q
|
|---|
| 75 | S:RXF'="" GONE=$P($G(^PSRX(PSXPTR,1,RXF,0)),U,18)
|
|---|
| 76 | S:RXF="" GONE=$P($G(^PSRX(PSXPTR,2)),U,13)
|
|---|
| 77 | I (STAT="P")&(PRINT=1)&($G(GONE)="") D RESET
|
|---|
| 78 | K GONE,RXF,XXF
|
|---|
| 79 | Q
|
|---|
| 80 | RESET ;resets the Queued/Printed flags to Queued and not Printed
|
|---|
| 81 | L +^PS(52.5,REC):DTIME Q:'$T
|
|---|
| 82 | S DIE="^PS(52.5,",DA=REC,DR="2////2;3////Q" D ^DIE L -^PS(52.5,REC) K DIE,DR,DA
|
|---|
| 83 | S:$G(PSXVER) $P(^PSRX(PSXPTR,"STA"),U,1)=5 S:'$G(PSXVER) $P(^PSRX(PSXPTR,0),U,15)=5 K ^PS(52.5,"AC",DFN,SDT,REC)
|
|---|
| 84 | Q
|
|---|
| 85 | PRTERR ; auto error trap for prt cmop local
|
|---|
| 86 | S XXERR=$$EC^%ZOSV
|
|---|
| 87 | S PSXDIVNM=$$GET1^DIQ(59,PSOSITE,.01)
|
|---|
| 88 | ;save an image of the transient file 550.1 for 2 days
|
|---|
| 89 | D NOW^%DTC S DTTM=%
|
|---|
| 90 | S X=$$FMADD^XLFDT(DT,+2) S ^XTMP("PSXERR "_DTTM,0)=X_U_DT_U_"CMOP "_XXERR
|
|---|
| 91 | M ^XTMP("PSXERR "_DTTM,550.1)=^PSX(550.1)
|
|---|
| 92 | S XMSUB="CMOP Error "_PSXDIVNM_" "_$$GET1^DIQ(550.2,+$G(PSXBAT),.01)
|
|---|
| 93 | D GRP1^PSXNOTE
|
|---|
| 94 | ;S XMY(DUZ)=""
|
|---|
| 95 | S XMTEXT="TEXT("
|
|---|
| 96 | S TEXT(1,0)=$S($G(PSXCS):"",1:"NON-")_"CS CMOP Print Local encountered the following error. Please investigate"
|
|---|
| 97 | S TEXT(2,0)="Division: "_PSXDIVNM
|
|---|
| 98 | S TEXT(3,0)="Type/Batch "_$S($G(PSXCS):"CS",1:"NON-CS")_" / "_$$GET1^DIQ(550.2,$G(PSXBAT),.01)
|
|---|
| 99 | S TEXT(4,0)="Error: "_XXERR
|
|---|
| 100 | S TEXT(5,0)="This batch has been set to closed."
|
|---|
| 101 | S TEXT(6,0)="Call NVS to investigate which prescriptions have been printed and which are yet to print."
|
|---|
| 102 | S TEXT(7,0)="A copy of file 550.1 can be found in ^XTMP(""PSXERR "_DTTM_""")"
|
|---|
| 103 | D ^%ZTER
|
|---|
| 104 | D ^XMD
|
|---|
| 105 | I $G(PSXBAT) D
|
|---|
| 106 | . N DA,DIE,DR S DIE="^PSX(550.2,",DA=PSXBAT,DR="1////4"
|
|---|
| 107 | . D ^DIE
|
|---|
| 108 | G UNWIND^%ZTER
|
|---|
| 109 | ;
|
|---|
| 110 | SBTECME(PSXTP,PSXDV,THRDT,PULLDT) ; - Sumitting prescriptions to EMCE (3rd Party Billing)
|
|---|
| 111 | ;Input: PSXTP - Type of prescriptions "C" - Controlled Subs / "N" Non-Controlled Subs
|
|---|
| 112 | ; PSXDV - Pointer to DIVSION file (#59)
|
|---|
| 113 | ; THRDT - T+N when scheduling the THROUGH DATE to run CMOP Transmission
|
|---|
| 114 | ; PULLDT - T+N+PULL DAYS parameter in the DIVISION file (#59)
|
|---|
| 115 | ;Output:SBTECME- Number of prescriptions submitted to ECME
|
|---|
| 116 | N RX,RFL,SBTECME,PSOLRX,RESP,SDT,XDFN,REC,PSOLRX,DOS
|
|---|
| 117 | I '$$ECMEON^BPSUTIL(PSXDV)!'$$CMOPON^BPSUTIL(PSXDV) Q
|
|---|
| 118 | S (SDT,SBTECME)=0 K ^TMP("PSXEPHDFN",$J)
|
|---|
| 119 | F S SDT=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT)) S XDFN=0 Q:(SDT>PULLDT)!(SDT'>0) D
|
|---|
| 120 | . F S XDFN=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN)) S REC=0 Q:(XDFN'>0)!(XDFN="") D
|
|---|
| 121 | . . F S REC=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN,REC)) Q:(REC'>0)!(REC="") D
|
|---|
| 122 | . . . S (PSOLRX,RX)=+$$GET1^DIQ(52.5,REC,.01,"I") I 'RX Q
|
|---|
| 123 | . . . S RFL=$$GET1^DIQ(52.5,REC,9,"I") I RFL="" S RFL=$$LSTRFL^PSOBPSU1(RX)
|
|---|
| 124 | . . . I $$XMIT^PSXBPSUT(REC) D
|
|---|
| 125 | . . . . I SDT>THRDT,'$D(^TMP("PSXEPHDFN",$J,XDFN)) Q
|
|---|
| 126 | . . . . I $$PATCH^XPDUTL("PSO*7.0*148") D
|
|---|
| 127 | . . . . . I $$RETRX^PSOBPSUT(RX,RFL),SDT>DT Q
|
|---|
| 128 | . . . . . I $$DOUBLE(RX,RFL) Q
|
|---|
| 129 | . . . . . I $$FIND^PSOREJUT(RX,RFL) Q
|
|---|
| 130 | . . . . . I '$$RETRX^PSOBPSUT(RX,RFL),$$STATUS^PSOBPSUT(RX,RFL)'="" Q
|
|---|
| 131 | . . . . . S DOS=$$RXFLDT^PSOBPSUT(RX,RFL) I DOS>DT S DOS=DT
|
|---|
| 132 | . . . . . D ECMESND^PSOBPSU1(RX,RFL,DOS,"PC",,1,,,,.RESP)
|
|---|
| 133 | . . . . . I $D(RESP),'RESP S SBTECME=SBTECME+1
|
|---|
| 134 | . . . . . S ^TMP("PSXEPHDFN",$J,XDFN)=""
|
|---|
| 135 | . . . D PSOUL^PSSLOCK(PSOLRX)
|
|---|
| 136 | K ^TMP("PSXEPHDFN",$J)
|
|---|
| 137 | Q SBTECME
|
|---|
| 138 | ;
|
|---|
| 139 | DOUBLE(RX,RFL) ; Checks if previous fill is still being worked on by CMOP
|
|---|
| 140 | ;Input: (r) RX - Prescription IEN
|
|---|
| 141 | ; (r) RFL - Fill number
|
|---|
| 142 | ;Output: 0 - Previous fill not with CMOP / 1 - CMOP working on previous fill
|
|---|
| 143 | N CMP,DOUBLE,STS
|
|---|
| 144 | ;
|
|---|
| 145 | I 'RFL!'$D(^PSRX(RX,4)) Q 0
|
|---|
| 146 | I $$STATUS^PSOBPSUT(RX,RFL-1)="" Q 0
|
|---|
| 147 | S DOUBLE=0,CMP=999
|
|---|
| 148 | F S CMP=$O(^PSRX(RX,4,CMP),-1) Q:'CMP D I DOUBLE Q
|
|---|
| 149 | . I $$GET1^DIQ(52.01,CMP_","_RX,2,"I")'=(RFL-1) Q
|
|---|
| 150 | . S STS=$$GET1^DIQ(52.01,CMP_","_RX,3,"I")
|
|---|
| 151 | . I STS=0!(STS=2) S DOUBLE=1
|
|---|
| 152 | Q DOUBLE
|
|---|
| 153 | ;
|
|---|
| 154 | EXIT ;
|
|---|
| 155 | K DFN,PSXDAYS,PSXDTRG,SWITCH,STAT,PRINT,PSXTRANS,REC,REPLY,SDT,X,X1,X2,Y,ANSWER,STATUS,PSXFLAG,PSXPTR,PSXSTAT
|
|---|
| 156 | K DIR,DIRUT,DTOUT,DUOUT,DIROUT
|
|---|
| 157 | Q
|
|---|
