PSOERRX2 ;BIRM/RRM - All Rxs eRx Queue - Supporting APIs ;09/23/24
;;7.0;OUTPATIENT PHARMACY;**770**;DEC 1997;Build 145
;
ADDFLTR(RESCODE,FILTER) ;prompt user for additional filter when prompted for response type in the search queue
;Input : RESCODE - The RESPONSE VALUE from File #52.49 field 52.1
; FILTER - The message type filter. Example format:RXRENEWALRESPONSE/DENIED
;Note: Currently, the code below only prompt for DENIED response type
Q:$G(RESCODE)=""
N DIR,DIRUT,DIROUT,EXTSCODE,PSOQUIT,INDEX,HLP,CODE,LINE,DNDDESC
S DIR(0)="AO"
S PSOQUIT=0
I (" D "[(" "_RESCODE_" ")) D I $G(PSOQUIT)
. K INDEX K DIR S DIR(0)="SO^ALL:ALL;",DIR("L",1)=" Select one of the following:",DIR("L",2)=" "
. S HLP=0,LINE=2,DIR("L")=" "_$S(RESCODE="D":"Type '?' for the full list. ",1:"")
. S DIR("?")="^D HELP^PSOERCR0"
. S CODE=0 F S CODE=$O(^PS(52.45,"TYPE","CLQ",CODE)) Q:'CODE D
. . S INDEX($$GET1^DIQ(52.45,CODE,.01))=CODE
. . S DIR(0)=DIR(0)_$$GET1^DIQ(52.45,CODE,.01)_":"_$$GET1^DIQ(52.45,CODE,.02)_";"
. . ;
. . I RESCODE="D"&(",AE,AF,AM,"[(","_$$GET1^DIQ(52.45,CODE,.01)_",")) D
. . . S LINE=LINE+1,DIR("L",LINE)=" "_$S(RESCODE="D":" ",1:"")_$$GET1^DIQ(52.45,CODE,.01)_" - "_$$GET1^DIQ(52.45,CODE,.02)
. . S HLP=HLP+1,DIR("?",HLP)=" "_$S(RESCODE="D":" ",1:"")_$$GET1^DIQ(52.45,CODE,.01)_" - "_$$GET1^DIQ(52.45,CODE,.02)
. I RESCODE="D" S LINE=LINE+1,DIR("L",LINE)=" "
. S DIR("A")="DENIED REASON CODE",DIR("B")="ALL"
. I $G(REASCODE) S DIR("B")=$$GET1^DIQ(52.45,REASCODE,.01)
. D ^DIR I $D(DIRUT)!$D(DIROUT) S PSOQUIT=1 K MSTPFLTR1,MSTPFLTR Q
. I $G(Y)="ALL" M DNDARY=INDEX K REASCODE
. E D
. . S REASCODE=+$G(INDEX(Y)),EXTSCODE=$$GET1^DIQ(52.45,REASCODE,.01),DNDDESC=$$GET1^DIQ(52.45,REASCODE,.02)
. . S DNDARY(EXTSCODE)=REASCODE_"^"_DNDDESC
. S MSTPFLTR1=$G(FILTER)_"/"_$S($G(Y)="ALL":"ALL",1:EXTSCODE)
Q
;
DNDRCODE(ERXIEN) ;Return the Denied Reason Code
;Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
;Output: Return the Denied Reason Code. Example: AE
Q:$G(ERXIEN)=""
N ERESCODE,CODEIEN,RESDESC,DNDRCODE
S IENS=ERXIEN_","
S DNDRCODE=""
S I=0 F S I=$O(^PS(52.49,ERXIEN,55,I)) Q:'I D
. S ERESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
. S CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
. S RESDESC=$$GET1^DIQ(52.45,CODEIEN,.02,"E")
. S DNDRCODE=ERESCODE
Q DNDRCODE
;
REQCODE(REQFLTR) ;Prompt user for the 'CR' RXCHANGEREQUEST Codes
;Input: REQFLTR - The message type filter. Example format:RXCHANGEREQUEST
;
N INDEX,CODE,HLP,DESC,HELP,I,WRPHELP,DIRUT,DIROUT,REASCODE,EXTRCODE,REQDESC
K INDEX S CODE=0 K DIR S DIR(0)="SO^ALL:ALL;",HLP=0,DIR("?")=" "
F S CODE=$O(^PS(52.45,"TYPE","MRC",CODE)) Q:'CODE D
. S INDEX($$GET1^DIQ(52.45,CODE,.01))=CODE
. S DIR(0)=DIR(0)_$$GET1^DIQ(52.45,CODE,.01)_":"_$$GET1^DIQ(52.45,CODE,.02)_";"
. S HLP=HLP+1,DIR("?",HLP)=" "_$$GET1^DIQ(52.45,CODE,.01)_" - "
. K DESC S X=$$GET1^DIQ(52.45,CODE,1,"","DESC") I '$D(DESC) Q
. S HELP=$G(DESC(1)) F I=2:1 Q:'$D(DESC(I)) S HELP=HELP_" "_DESC(I)
. K WRPHELP D WRAP^PSOERUT(HELP,70,.WRPHELP)
. F I=1:1 Q:'$D(WRPHELP(I)) S:I>1 HLP=HLP+1 S $E(DIR("?",HLP),10)=$G(WRPHELP(I,0))
S DIR("A")="CHANGE REQUEST CODE",DIR("B")="ALL"
I $G(REACODE) S DIR("B")=$$GET1^DIQ(52.45,REACODE,.01)
D ^DIR I $D(DIRUT)!$D(DIROUT) Q
I $G(Y)="ALL" M RXREQARY=INDEX
E D
. S REACODE=+$G(INDEX(Y))
. S EXTRCODE=$$GET1^DIQ(52.45,REACODE,.01)
. S REQDESC=$$GET1^DIQ(52.45,REACODE,.02)
. S RXREQARY(EXTRCODE)=""
S MSTPFLTR1=$G(REQFLTR)_"/"_$S($G(Y)="ALL":"ALL",1:$E(REQDESC,1,28))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERRX2 3623 printed Aug 26, 2025@22:43:59 Page 2
PSOERRX2 ;BIRM/RRM - All Rxs eRx Queue - Supporting APIs ;09/23/24
+1 ;;7.0;OUTPATIENT PHARMACY;**770**;DEC 1997;Build 145
+2 ;
ADDFLTR(RESCODE,FILTER) ;prompt user for additional filter when prompted for response type in the search queue
+1 ;Input : RESCODE - The RESPONSE VALUE from File #52.49 field 52.1
+2 ; FILTER - The message type filter. Example format:RXRENEWALRESPONSE/DENIED
+3 ;Note: Currently, the code below only prompt for DENIED response type
+4 if $GET(RESCODE)=""
QUIT
+5 NEW DIR,DIRUT,DIROUT,EXTSCODE,PSOQUIT,INDEX,HLP,CODE,LINE,DNDDESC
+6 SET DIR(0)="AO"
+7 SET PSOQUIT=0
+8 IF (" D "[(" "_RESCODE_" "))
Begin DoDot:1
+9 KILL INDEX
KILL DIR
SET DIR(0)="SO^ALL:ALL;"
SET DIR("L",1)=" Select one of the following:"
SET DIR("L",2)=" "
+10 SET HLP=0
SET LINE=2
SET DIR("L")=" "_$SELECT(RESCODE="D":"Type '?' for the full list. ",1:"")
+11 SET DIR("?")="^D HELP^PSOERCR0"
+12 SET CODE=0
FOR
SET CODE=$ORDER(^PS(52.45,"TYPE","CLQ",CODE))
if 'CODE
QUIT
Begin DoDot:2
+13 SET INDEX($$GET1^DIQ(52.45,CODE,.01))=CODE
+14 SET DIR(0)=DIR(0)_$$GET1^DIQ(52.45,CODE,.01)_":"_$$GET1^DIQ(52.45,CODE,.02)_";"
+15 ;
+16 IF RESCODE="D"&(",AE,AF,AM,"[(","_$$GET1^DIQ(52.45,CODE,.01)_","))
Begin DoDot:3
+17 SET LINE=LINE+1
SET DIR("L",LINE)=" "_$SELECT(RESCODE="D":" ",1:"")_$$GET1^DIQ(52.45,CODE,.01)_" - "_$$GET1^DIQ(52.45,CODE,.02)
End DoDot:3
+18 SET HLP=HLP+1
SET DIR("?",HLP)=" "_$SELECT(RESCODE="D":" ",1:"")_$$GET1^DIQ(52.45,CODE,.01)_" - "_$$GET1^DIQ(52.45,CODE,.02)
End DoDot:2
+19 IF RESCODE="D"
SET LINE=LINE+1
SET DIR("L",LINE)=" "
+20 SET DIR("A")="DENIED REASON CODE"
SET DIR("B")="ALL"
+21 IF $GET(REASCODE)
SET DIR("B")=$$GET1^DIQ(52.45,REASCODE,.01)
+22 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
SET PSOQUIT=1
KILL MSTPFLTR1,MSTPFLTR
QUIT
+23 IF $GET(Y)="ALL"
MERGE DNDARY=INDEX
KILL REASCODE
+24 IF '$TEST
Begin DoDot:2
+25 SET REASCODE=+$GET(INDEX(Y))
SET EXTSCODE=$$GET1^DIQ(52.45,REASCODE,.01)
SET DNDDESC=$$GET1^DIQ(52.45,REASCODE,.02)
+26 SET DNDARY(EXTSCODE)=REASCODE_"^"_DNDDESC
End DoDot:2
+27 SET MSTPFLTR1=$GET(FILTER)_"/"_$SELECT($GET(Y)="ALL":"ALL",1:EXTSCODE)
End DoDot:1
IF $GET(PSOQUIT)
+28 QUIT
+29 ;
DNDRCODE(ERXIEN) ;Return the Denied Reason Code
+1 ;Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ;Output: Return the Denied Reason Code. Example: AE
+3 if $GET(ERXIEN)=""
QUIT
+4 NEW ERESCODE,CODEIEN,RESDESC,DNDRCODE
+5 SET IENS=ERXIEN_","
+6 SET DNDRCODE=""
+7 SET I=0
FOR
SET I=$ORDER(^PS(52.49,ERXIEN,55,I))
if 'I
QUIT
Begin DoDot:1
+8 SET ERESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
+9 SET CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
+10 SET RESDESC=$$GET1^DIQ(52.45,CODEIEN,.02,"E")
+11 SET DNDRCODE=ERESCODE
End DoDot:1
+12 QUIT DNDRCODE
+13 ;
REQCODE(REQFLTR) ;Prompt user for the 'CR' RXCHANGEREQUEST Codes
+1 ;Input: REQFLTR - The message type filter. Example format:RXCHANGEREQUEST
+2 ;
+3 NEW INDEX,CODE,HLP,DESC,HELP,I,WRPHELP,DIRUT,DIROUT,REASCODE,EXTRCODE,REQDESC
+4 KILL INDEX
SET CODE=0
KILL DIR
SET DIR(0)="SO^ALL:ALL;"
SET HLP=0
SET DIR("?")=" "
+5 FOR
SET CODE=$ORDER(^PS(52.45,"TYPE","MRC",CODE))
if 'CODE
QUIT
Begin DoDot:1
+6 SET INDEX($$GET1^DIQ(52.45,CODE,.01))=CODE
+7 SET DIR(0)=DIR(0)_$$GET1^DIQ(52.45,CODE,.01)_":"_$$GET1^DIQ(52.45,CODE,.02)_";"
+8 SET HLP=HLP+1
SET DIR("?",HLP)=" "_$$GET1^DIQ(52.45,CODE,.01)_" - "
+9 KILL DESC
SET X=$$GET1^DIQ(52.45,CODE,1,"","DESC")
IF '$DATA(DESC)
QUIT
+10 SET HELP=$GET(DESC(1))
FOR I=2:1
if '$DATA(DESC(I))
QUIT
SET HELP=HELP_" "_DESC(I)
+11 KILL WRPHELP
DO WRAP^PSOERUT(HELP,70,.WRPHELP)
+12 FOR I=1:1
if '$DATA(WRPHELP(I))
QUIT
if I>1
SET HLP=HLP+1
SET $EXTRACT(DIR("?",HLP),10)=$GET(WRPHELP(I,0))
End DoDot:1
+13 SET DIR("A")="CHANGE REQUEST CODE"
SET DIR("B")="ALL"
+14 IF $GET(REACODE)
SET DIR("B")=$$GET1^DIQ(52.45,REACODE,.01)
+15 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+16 IF $GET(Y)="ALL"
MERGE RXREQARY=INDEX
+17 IF '$TEST
Begin DoDot:1
+18 SET REACODE=+$GET(INDEX(Y))
+19 SET EXTRCODE=$$GET1^DIQ(52.45,REACODE,.01)
+20 SET REQDESC=$$GET1^DIQ(52.45,REACODE,.02)
+21 SET RXREQARY(EXTRCODE)=""
End DoDot:1
+22 SET MSTPFLTR1=$GET(REQFLTR)_"/"_$SELECT($GET(Y)="ALL":"ALL",1:$EXTRACT(REQDESC,1,28))
+23 QUIT
