PSOERXUX ;BIRM/MFR - eRx Un Process action ;07/19/23
;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
;
UNPROC ; Un-Process
I '$D(PSOIEN) D MSG("No eRx IEN found") Q
D FULL^VALM1
N DIR,ERXSTAT,UKEY,PSRXNUM,STAT,MTYPE,RVALUE,RVFLAG,SEQ,CMFLAG,PSODFN,PSOPLCK,DIE,DA,DR,HCOMM,INCOM
N Y,REA,PSONOOR,RCODE,RESP,FDA,PSCAN,PSOCANRC,PSOCANRD,PSOCANRN
;
; #1 - Check if status is "Processed"
S ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
I ERXSTAT'="PR"!"RXP"!"CXP" D MSG("eRx status must be 'PR','RXP', or 'CXP' to Un-Process") Q
;
; #2 - Check if user hold the KEY "PSDRPH"
S UKEY=$O(^DIC(19.1,"B","PSDRPH",0))
I '$D(^VA(200,DUZ,51,"B",UKEY)) D MSG("Cannot Un-Process if you don't hold the KEY 'PSDRPH'") Q
;
; #3 - Check if 52.49/.13 exists
S PSRXNUM=$P(^PS(52.49,PSOIEN,0),"^",12)
I 'PSRXNUM D MSG("No prescription number found in eRx") Q
;
; #4 - Check 52/zero node
I '$D(^PSRX(PSRXNUM,0)) D MSG("Prescription number not valid") Q
;
; #5 - Check Message Type, only "N","RE", and "CX" can be Un-Processed
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
I ",N,RE,CX,"'[(","_MTYPE_",") D MSG("Cannot Un-Process Message Types other than 'N','RE', or 'CX'") Q
;
; #6 - Check Message Type RXRENEWALRESPONSE, it must have a Response Value of "REPLACE"
I MTYPE="RE" D
. S RVALUE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
. I RVALUE'="R" S RVFLAG=1
I $G(RVFLAG) D MSG("RXRENEWALRESPONSE does not have a Response Value of 'REPLACE'") Q
;
; #7 - Check if original fill, check if partial entered, check if transmitted to CMOP
I $D(^PSRX(PSRXNUM,1)) D MSG("Refill(s) already entered, cannot Un-Process") Q ;Refill request
I $D(^PSRX(PSRXNUM,"P")) D MSG("Partial(s) already entered, cannot Un-Process") Q ;At least 1 partial has been entered
;
; #8 - CMOP logic - check if original fill and if not dispensed
I $D(^PSRX(PSRXNUM,4)) D
. S SEQ=0
. F S SEQ=$O(^PSRX(PSRXNUM,4,SEQ)) Q:'SEQ D
. . I ($P($G(^PSRX(PSRXNUM,4,SEQ,0)),"^",3)'=0),($P($G(^PSRX(PSRXNUM,4,SEQ,0)),"^",4)'=3) S CMFLAG=1
I $G(CMFLAG) D MSG("Already transmitted to CMOP, cannot Un-Process") Q
;
; #9 - Check 52/100 if value is 5 (Suspended) or 3 (Hold)
S STAT=+$G(^PSRX(PSRXNUM,"STA"))
I STAT'=5,STAT'=3 D MSG("Prescription status is not SUSPENDED or HOLD") Q
;
; User comments, to both 52 and 52.49
S DIR("A")="Comments",DIR("B")="Un-Process for correction",DIR(0)="F^5:100" D ^DIR K DIR
S (HCOMM,INCOM)=Y
;
; Final confirmation to Un-Process
S DIR(0)="YO",DIR("A")="Would you like to 'Un-Process' eRx #"_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_" and Rx #"_$$GET1^DIQ(52,PSRXNUM,.01,"E")
S DIR("B")="Y" D ^DIR K DIR
Q:'Y
;
; Once the user confirms the Un-Process, then put a lock/unlock on the patient
S PSODFN=+$P(^PSRX(PSRXNUM,0),"^",2)
S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) Q
;
CANCEL ; Requirement - DC - discontinue prescription (PSO CANCEL)
S PSONOOR="S",DA=PSRXNUM,REA="C"
S PSOCANRC=DUZ,PSOCANRN=$P(^VA(200,DUZ,0),"^"),PSOCANRD=$P(^PSRX(DA,0),"^",4)
S PSCAN(+^PSRX(DA,0))=DA_"^C"
D CAN1^PSOCAN3
;
; Replace status code from 12 (Discontinued) to 15 (Discontinued - Edit)
S DIE=52,DA=PSRXNUM,DR="100///15" D ^DIE K DIE
;
; Replace Reason code in RX activity log from "C" (Discontinued) to "E" (Edit)
S RCODE=+$P($G(^PSRX(PSRXNUM,"A",0)),"^",3)
I $G(RCODE) S $P(^PSRX(PSRXNUM,"A",RCODE,0),"^",2)="E"
;
D UL^PSSLOCK(PSODFN)
;
ERX ; Change eRx status to "Wait"
S RESP=$O(^PS(52.45,"C","ERX","W",0))
S DIE="52.49",DR="1///"_RESP,DA=PSOIEN D ^DIE K DIE
; Add eRx history
S FDA(52.4919,"+1,"_PSOIEN_",",.01)=$$NOW^XLFDT()
S FDA(52.4919,"+1,"_PSOIEN_",",.02)=RESP
S FDA(52.4919,"+1,"_PSOIEN_",",.03)=$G(DUZ)
S FDA(52.4919,"+1,"_PSOIEN_",",1)=HCOMM
D UPDATE^DIE(,"FDA","NEWSTAT","ERR") K FDA
S VALMBCK="R"
Q
;
MSG(TXT) ;
S DIR("A",1)="",DIR("A")="Press Enter to continue"
S DIR("A",2)=TXT
S DIR(0)="FO"
D ^DIR K DIR
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXUX 3962 printed Apr 09, 2024@21:27:37 Page 2
PSOERXUX ;BIRM/MFR - eRx Un Process action ;07/19/23
+1 ;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
+2 ;
UNPROC ; Un-Process
+1 IF '$DATA(PSOIEN)
DO MSG("No eRx IEN found")
QUIT
+2 DO FULL^VALM1
+3 NEW DIR,ERXSTAT,UKEY,PSRXNUM,STAT,MTYPE,RVALUE,RVFLAG,SEQ,CMFLAG,PSODFN,PSOPLCK,DIE,DA,DR,HCOMM,INCOM
+4 NEW Y,REA,PSONOOR,RCODE,RESP,FDA,PSCAN,PSOCANRC,PSOCANRD,PSOCANRN
+5 ;
+6 ; #1 - Check if status is "Processed"
+7 SET ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+8 IF ERXSTAT'="PR"!"RXP"!"CXP"
DO MSG("eRx status must be 'PR','RXP', or 'CXP' to Un-Process")
QUIT
+9 ;
+10 ; #2 - Check if user hold the KEY "PSDRPH"
+11 SET UKEY=$ORDER(^DIC(19.1,"B","PSDRPH",0))
+12 IF '$DATA(^VA(200,DUZ,51,"B",UKEY))
DO MSG("Cannot Un-Process if you don't hold the KEY 'PSDRPH'")
QUIT
+13 ;
+14 ; #3 - Check if 52.49/.13 exists
+15 SET PSRXNUM=$PIECE(^PS(52.49,PSOIEN,0),"^",12)
+16 IF 'PSRXNUM
DO MSG("No prescription number found in eRx")
QUIT
+17 ;
+18 ; #4 - Check 52/zero node
+19 IF '$DATA(^PSRX(PSRXNUM,0))
DO MSG("Prescription number not valid")
QUIT
+20 ;
+21 ; #5 - Check Message Type, only "N","RE", and "CX" can be Un-Processed
+22 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+23 IF ",N,RE,CX,"'[(","_MTYPE_",")
DO MSG("Cannot Un-Process Message Types other than 'N','RE', or 'CX'")
QUIT
+24 ;
+25 ; #6 - Check Message Type RXRENEWALRESPONSE, it must have a Response Value of "REPLACE"
+26 IF MTYPE="RE"
Begin DoDot:1
+27 SET RVALUE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
+28 IF RVALUE'="R"
SET RVFLAG=1
End DoDot:1
+29 IF $GET(RVFLAG)
DO MSG("RXRENEWALRESPONSE does not have a Response Value of 'REPLACE'")
QUIT
+30 ;
+31 ; #7 - Check if original fill, check if partial entered, check if transmitted to CMOP
+32 ;Refill request
IF $DATA(^PSRX(PSRXNUM,1))
DO MSG("Refill(s) already entered, cannot Un-Process")
QUIT
+33 ;At least 1 partial has been entered
IF $DATA(^PSRX(PSRXNUM,"P"))
DO MSG("Partial(s) already entered, cannot Un-Process")
QUIT
+34 ;
+35 ; #8 - CMOP logic - check if original fill and if not dispensed
+36 IF $DATA(^PSRX(PSRXNUM,4))
Begin DoDot:1
+37 SET SEQ=0
+38 FOR
SET SEQ=$ORDER(^PSRX(PSRXNUM,4,SEQ))
if 'SEQ
QUIT
Begin DoDot:2
+39 IF ($PIECE($GET(^PSRX(PSRXNUM,4,SEQ,0)),"^",3)'=0)
IF ($PIECE($GET(^PSRX(PSRXNUM,4,SEQ,0)),"^",4)'=3)
SET CMFLAG=1
End DoDot:2
End DoDot:1
+40 IF $GET(CMFLAG)
DO MSG("Already transmitted to CMOP, cannot Un-Process")
QUIT
+41 ;
+42 ; #9 - Check 52/100 if value is 5 (Suspended) or 3 (Hold)
+43 SET STAT=+$GET(^PSRX(PSRXNUM,"STA"))
+44 IF STAT'=5
IF STAT'=3
DO MSG("Prescription status is not SUSPENDED or HOLD")
QUIT
+45 ;
+46 ; User comments, to both 52 and 52.49
+47 SET DIR("A")="Comments"
SET DIR("B")="Un-Process for correction"
SET DIR(0)="F^5:100"
DO ^DIR
KILL DIR
+48 SET (HCOMM,INCOM)=Y
+49 ;
+50 ; Final confirmation to Un-Process
+51 SET DIR(0)="YO"
SET DIR("A")="Would you like to 'Un-Process' eRx #"_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_" and Rx #"_$$GET1^DIQ(52,PSRXNUM,.01,"E")
+52 SET DIR("B")="Y"
DO ^DIR
KILL DIR
+53 if 'Y
QUIT
+54 ;
+55 ; Once the user confirms the Un-Process, then put a lock/unlock on the patient
+56 SET PSODFN=+$PIECE(^PSRX(PSRXNUM,0),"^",2)
+57 SET PSOPLCK=$$L^PSSLOCK(PSODFN,0)
IF '$GET(PSOPLCK)
QUIT
+58 ;
CANCEL ; Requirement - DC - discontinue prescription (PSO CANCEL)
+1 SET PSONOOR="S"
SET DA=PSRXNUM
SET REA="C"
+2 SET PSOCANRC=DUZ
SET PSOCANRN=$PIECE(^VA(200,DUZ,0),"^")
SET PSOCANRD=$PIECE(^PSRX(DA,0),"^",4)
+3 SET PSCAN(+^PSRX(DA,0))=DA_"^C"
+4 DO CAN1^PSOCAN3
+5 ;
+6 ; Replace status code from 12 (Discontinued) to 15 (Discontinued - Edit)
+7 SET DIE=52
SET DA=PSRXNUM
SET DR="100///15"
DO ^DIE
KILL DIE
+8 ;
+9 ; Replace Reason code in RX activity log from "C" (Discontinued) to "E" (Edit)
+10 SET RCODE=+$PIECE($GET(^PSRX(PSRXNUM,"A",0)),"^",3)
+11 IF $GET(RCODE)
SET $PIECE(^PSRX(PSRXNUM,"A",RCODE,0),"^",2)="E"
+12 ;
+13 DO UL^PSSLOCK(PSODFN)
+14 ;
ERX ; Change eRx status to "Wait"
+1 SET RESP=$ORDER(^PS(52.45,"C","ERX","W",0))
+2 SET DIE="52.49"
SET DR="1///"_RESP
SET DA=PSOIEN
DO ^DIE
KILL DIE
+3 ; Add eRx history
+4 SET FDA(52.4919,"+1,"_PSOIEN_",",.01)=$$NOW^XLFDT()
+5 SET FDA(52.4919,"+1,"_PSOIEN_",",.02)=RESP
+6 SET FDA(52.4919,"+1,"_PSOIEN_",",.03)=$GET(DUZ)
+7 SET FDA(52.4919,"+1,"_PSOIEN_",",1)=HCOMM
+8 DO UPDATE^DIE(,"FDA","NEWSTAT","ERR")
KILL FDA
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
MSG(TXT) ;
+1 SET DIR("A",1)=""
SET DIR("A")="Press Enter to continue"
+2 SET DIR("A",2)=TXT
+3 SET DIR(0)="FO"
+4 DO ^DIR
KILL DIR
+5 SET VALMBCK="R"
+6 QUIT
