Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSXRPPL1

PSXRPPL1.m

Go to the documentation of this file. 
  1. PSXRPPL1 ;BIR/WPB-Resets Suspense to Print/Transmit ;29-May-2012 15:19;PLS
  1.  ;;2.0;CMOP;**3,48,62,66,65,1015**;11 Apr 97;Build 62
  1.  ;Reference to ^PSRX( supported by DBIA #1977
  1.  ;Reference to File #59  supported by DBIA #1976
  1.  ;Reference to PSOSURST  supported by DBIA #1970
  1.  ;Reference to ^PS(52.5, supported by DBIA #1978
  1.  ;Reference to ^BPSUTIL  supported by DBIA #4410
  1.  ;Reference to ^PSSLOCK  supported by DBIA #2789
  1.  ;Reference to ^PSOBPSUT supported by DBIA #4701
  1.  ;Reference to ^PSOBPSU1 supported by DBIA #4702
  1.  ;Reference to ^PSOREJUT supported by DBIA #4706
  1.  ;Reference to ^PSOREJU3 supported by DBIA #5186
  1.  ;Reference to ^PSOBPSU2 supported by DBIA #4970
  1.  ;Reference to ^PSOSULB1 supported by DBIA #2478
  1.  ;
  1.  ;Modified - IHS/MSC/PLS - 05/28/2010 - Line SBTECME+8
  1.  ;
  1.  ;This routine will reset the Queued flags and the printed flags in
  1.  ;PS(52.5 to 'Queued' and 'Printed' respectively and either retransmits
  1.  ;the data to the CMOP or prints the labels.
  1. START ;initializes local variables
  1.  I '$D(^XUSEC("PSXCMOPMGR",DUZ)) W !,"You are not authorized to use this option!" Q
  1.  I '$D(^XUSEC("PSX XMIT",DUZ)) W !,"You are not authorized to use this option!" Q
  1.  S SWITCH=0
  1.  K ^TMP($J,"PSX")
  1. QRY ;initial message and option menu
  1.  W !
  1.  S DIR(0)="NAO^1:3:0",DIR("A")="Select (1, 2, 3):  ",DIR("A",1)="  1 - Reset CMOP Batches for Transmission"
  1.  S DIR("A",2)="  2 - Reprint CMOP Batches",DIR("A",4)="  3 - Standard Reprint Batches from Suspense"
  1.  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
  1.  I REPLY=1 S (PSXTRANS,PSXFLAG,SWITCH)=1 G:$G(PSXVER) ^PSXSRST G:'$G(PSXVER) BEGIN
  1.  I REPLY=2 S (PSXTRANS,PSXFLAG,SWITCH)=2 G:$G(PSXVER) ^PSXSRST G:'$G(PSXVER) BEGIN
  1.  I REPLY=3 S PSXFLG=1 G START^PSOSURST
  1.  K REPLY
  1.  Q
  1. BEGIN ;confirms CMOP processing, if Yes, checks for active site and status
  1.  ;in the CMOP System file, if not an active site or the system status
  1.  ;is not stopped the routine exits and processing stops
  1.  W !
  1.  S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to continue",DIR("?",1)="No - Exits."
  1.  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
  1.  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
  1. ASK ;gets date for the resets
  1.  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 ****",!!
  1. ASK1 I SWITCH=1 S %DT="AEX",%DT("A")="   BEGIN DATE:  " D ^%DT K %DT,%DT("A") G:Y<0 EXIT S PRTDT=Y
  1.  I SWITCH=2 S %DT="AEX",%DT("A")="   BEGIN DATE:  " D ^%DT K %DT,%DT("A") G:Y<0 EXIT S PRTDT=Y
  1.  W !! S %DT="AEX",%DT("A")="   ENDING DATE:  " D ^%DT Q:Y<0  S PSXDTRG=Y K %DT,%DT("A")
  1.  I $G(PRTDT)>$G(PSXDTRG) W !,"Begin Date must be before Ending Date!" G ASK1
  1.  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
  1.  D SDT S PSXERFLG=0
  1.  I SWITCH=1 D PSXTRANS Q
  1.  I SWITCH=2 D PRINT Q
  1.  S PSXSTAT="H" D PSXSTAT^PSXRSYU
  1.  G EXIT
  1. PSXTRANS ;
  1.  W !!
  1.  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
  1.  S PSXSTAT="T" D PSXSTAT^PSXRSYU,ASK^PSXRSUS
  1.  Q
  1. PRINT ;
  1.  W !!
  1.  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
  1.  S PSXSTAT="T" D PSXSTAT^PSXRSYU,ASK^PSXRSUS
  1.  Q
  1. SDT ;the following subroutines go through the PS(52.5 global and pull the
  1.  ;data needed to reset the Queued/Printed nodes
  1.  S SDT=PRTDT-1 F  S SDT=$O(^PS(52.5,"AP",SDT)),DFN=0 Q:(SDT>PSXDTRG)!(SDT="")  D DFN
  1.  Q
  1. DFN ;
  1.  F  S DFN=$O(^PS(52.5,"AP",SDT,DFN)),REC=0 Q:(DFN="")!(DFN'>0)  D REC
  1.  Q
  1. REC ;
  1.  F  S REC=$O(^PS(52.5,"AP",SDT,DFN,REC)) Q:(REC'>0)!(REC="")  D:$G(^PS(52.5,REC,0)) CHECK
  1.  K ZDIV
  1.  Q
  1. CHECK ;
  1.  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)
  1.  S RXF="" F XXF=0:0 S XXF=$O(^PSRX(PSXPTR,1,XXF)) Q:XXF'>0  S RXF=XXF
  1.  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
  1.  S:RXF'="" GONE=$P($G(^PSRX(PSXPTR,1,RXF,0)),U,18)
  1.  S:RXF="" GONE=$P($G(^PSRX(PSXPTR,2)),U,13)
  1.  I (STAT="P")&(PRINT=1)&($G(GONE)="") D RESET
  1.  K GONE,RXF,XXF
  1.  Q
  1. RESET ;resets the Queued/Printed flags to Queued and not Printed
  1.  L +^PS(52.5,REC):DTIME Q:'$T
  1.  S DIE="^PS(52.5,",DA=REC,DR="2////2;3////Q" D ^DIE L -^PS(52.5,REC) K DIE,DR,DA
  1.  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)
  1.  Q
  1. PRTERR ; auto error trap for prt cmop local
  1.  S XXERR=$$EC^%ZOSV
  1.  S PSXDIVNM=$$GET1^DIQ(59,PSOSITE,.01)
  1.  ;save an image of the transient file 550.1 for 2 days
  1.  D NOW^%DTC S DTTM=%
  1.  S X=$$FMADD^XLFDT(DT,+2) S ^XTMP("PSXERR "_DTTM,0)=X_U_DT_U_"CMOP "_XXERR
  1.  M ^XTMP("PSXERR "_DTTM,550.1)=^PSX(550.1)
  1.  S XMSUB="CMOP Error "_PSXDIVNM_" "_$$GET1^DIQ(550.2,+$G(PSXBAT),.01)
  1.  D GRP1^PSXNOTE
  1.  ;S XMY(DUZ)=""
  1.  S XMTEXT="TEXT("
  1.  S TEXT(1,0)=$S($G(PSXCS):"",1:"NON-")_"CS CMOP Print Local encountered the following error. Please investigate"
  1.  S TEXT(2,0)="Division:         "_PSXDIVNM
  1.  S TEXT(3,0)="Type/Batch        "_$S($G(PSXCS):"CS",1:"NON-CS")_" / "_$$GET1^DIQ(550.2,$G(PSXBAT),.01)
  1.  S TEXT(4,0)="Error:            "_XXERR
  1.  S TEXT(5,0)="This batch has been set to closed."
  1.  S TEXT(6,0)="Call NVS to investigate which prescriptions have been printed and which are yet to print."
  1.  S TEXT(7,0)="A copy of file 550.1 can be found in ^XTMP(""PSXERR "_DTTM_""")"
  1.  D ^%ZTER
  1.  D ^XMD
  1.  I $G(PSXBAT) D
  1.  . N DA,DIE,DR S DIE="^PSX(550.2,",DA=PSXBAT,DR="1////4"
  1.  . D ^DIE
  1.  G UNWIND^%ZTER
  1.  ;
  1. SBTECME(PSXTP,PSXDV,THRDT,PULLDT) ; - Sumitting prescriptions to EMCE (3rd Party Billing)
  1.  ;Input: PSXTP  - Type of prescriptions "C" - Controlled Subs / "N" Non-Controlled Subs
  1.  ;       PSXDV  - Pointer to DIVSION file (#59)
  1.  ;       THRDT  - T+N when scheduling the THROUGH DATE to run CMOP Transmission
  1.  ;       PULLDT - T+N+PULL DAYS parameter in the DIVISION file (#59)
  1.  ;Output:SBTECME- Number of prescriptions submitted to ECME
  1.  Q  ;IHS/MSC/PLS - 05/28/2010
  1.  N RX,RFL,SBTECME,PSOLRX,RESP,SDT,XDFN,REC,PSOLRX,DOS
  1.  I '$$ECMEON^BPSUTIL(PSXDV)!'$$CMOPON^BPSUTIL(PSXDV) Q
  1.  S (SDT,SBTECME)=0 K ^TMP("PSXEPHDFN",$J)
  1.  F  S SDT=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT)) S XDFN=0 Q:(SDT>PULLDT)!(SDT'>0)  D
  1.  . F  S XDFN=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN)) S REC=0 Q:(XDFN'>0)!(XDFN="")  D
  1.  . . F  S REC=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN,REC)) Q:(REC'>0)!(REC="")  D
  1.  . . . S (PSOLRX,RX)=+$$GET1^DIQ(52.5,REC,.01,"I") I 'RX Q
  1.  . . . S RFL=$$GET1^DIQ(52.5,REC,9,"I") I RFL="" S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  . . . I $$XMIT^PSXBPSUT(REC) D
  1.  . . . . I SDT>THRDT,'$D(^TMP("PSXEPHDFN",$J,XDFN)) Q
  1.  . . . . I $$PATCH^XPDUTL("PSO*7.0*148") D
  1.  . . . . . I $$RETRX^PSOBPSUT(RX,RFL),SDT>DT Q
  1.  . . . . . I $$DOUBLE(RX,RFL) Q
  1.  . . . . . I $$FIND^PSOREJUT(RX,RFL,,"79,88") Q
  1.  . . . . . I '$$RETRX^PSOBPSUT(RX,RFL),'$$ECMESTAT^PSXRPPL2(RX,RFL) Q
  1.  . . . . . I $$PATCH^XPDUTL("PSO*7.0*289") Q:'$$DUR^PSXRPPL2(RX,RFL)  ;ePharm Host error hold
  1.  . . . . . I $$PATCH^XPDUTL("PSO*7.0*289"),$$STATUS^PSOBPSUT(RX,RFL-1)'="" Q:'$$DSH^PSXRPPL2(REC)  ;ePharm 3/4 days supply
  1.  . . . . . S DOS=$$RXFLDT^PSOBPSUT(RX,RFL) I DOS>DT S DOS=DT
  1.  . . . . . D ECMESND^PSOBPSU1(RX,RFL,DOS,"PC",,1,,,,.RESP)
  1.  . . . . . I $$PATCH^XPDUTL("PSO*7.0*287"),$$TRISTA^PSOREJU3(RXN,RFL,.RESP,"PC") S ^TMP("PSXEPHNB",$J,RX,RFL)=$G(RESP)
  1.  . . . . . I $D(RESP),'RESP S SBTECME=SBTECME+1
  1.  . . . . . S ^TMP("PSXEPHDFN",$J,XDFN)=""
  1.  . . . D PSOUL^PSSLOCK(PSOLRX)
  1.  K ^TMP("PSXEPHDFN",$J)
  1.  Q SBTECME
  1.  ;
  1. DOUBLE(RX,RFL) ; Checks if previous fill is still being worked on by CMOP
  1.  ;Input: (r) RX  - Prescription IEN
  1.  ;       (r) RFL - Fill number
  1.  ;Output:    0 - Previous fill not with CMOP / 1 - CMOP working on previous fill
  1.  N CMP,DOUBLE,STS
  1.  ;
  1.  I 'RFL!'$D(^PSRX(RX,4)) Q 0
  1.  I $$STATUS^PSOBPSUT(RX,RFL-1)="" Q 0
  1.  S DOUBLE=0,CMP=999
  1.  F  S CMP=$O(^PSRX(RX,4,CMP),-1) Q:'CMP  D  I DOUBLE Q
  1.  . I $$GET1^DIQ(52.01,CMP_","_RX,2,"I")'=(RFL-1) Q
  1.  . S STS=$$GET1^DIQ(52.01,CMP_","_RX,3,"I")
  1.  . I STS=0!(STS=2) S DOUBLE=1
  1.  Q DOUBLE
  1.  ;
  1. EXIT ;
  1.  K DFN,PSXDAYS,PSXDTRG,SWITCH,STAT,PRINT,PSXTRANS,REC,REPLY,SDT,X,X1,X2,Y,ANSWER,STATUS,PSXFLAG,PSXPTR,PSXSTAT
  1.  K DIR,DIRUT,DTOUT,DUOUT,DIROUT
  1.  Q