source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXRPPL1.m@ 1764

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

initial load of WorldVistAEHR
File size: 7.8 KB
Line 
1PSXRPPL1 ;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.
16START ;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")
21QRY ;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
31BEGIN ;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
38ASK ;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 ****",!!
40ASK1 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
50PSXTRANS ;
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
55PRINT ;
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
60SDT ;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
64DFN ;
65 F S DFN=$O(^PS(52.5,"AP",SDT,DFN)),REC=0 Q:(DFN="")!(DFN'>0) D REC
66 Q
67REC ;
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
71CHECK ;
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
80RESET ;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
85PRTERR ; 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 ;
110SBTECME(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 ;
139DOUBLE(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 ;
154EXIT ;
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
Note: See TracBrowser for help on using the repository browser.