PSOBPSU4.m

PSOBPSU4 ;AITC/MRD - BPS (ECME) Utilities 4 ;10/29/2020

 ;;7.0;OUTPATIENT PHARMACY;**561,648,703**;DEC 1997;Build 16

 ;

BYPASSACT(PSORX) ; 'BY' hidden action, Bypass 3/4 Day Supply.

 ;

 ; The 'BY' hidden action allows the user to set a flag, BYPASS

 ; 3/4 DAY SUPPLY LOGIC, which, when set, causes the 3/4 day

 ; supply checks to be bypassed during CMOP processing.  If the

 ; flag is already set when the user performs the 'BY' action,

 ; the flag is reset to 'NO'.

 ;

 N DIR,PSOCOMMENT,PSOFILL,PSOFLAG,PSOREASON,Y

 ;

 D FULL^VALM1

 S VALMBCK="R"

 ;

 ; Determine current fill.

 ;

 S PSOFILL=$O(^PSRX(PSORX,1,"A"),-1)

 I PSOFILL="" S PSOFILL=0

 ;

 ; If the Rx/Fill is not e-billable, then display a message and

 ; Quit out.

 ;

 I '$$EBILLABLE^PSOSULB2(PSORX,PSOFILL) D  Q

 . W !!,*7,"***This option only applies to ePharmacy billable prescriptions***",!

 . S DIR(0)="E",DIR("A")="Press Return to Continue"

 . D ^DIR

 . Q

 ;

 ; Determine how the flag is currently set.

 ;

 S PSOFLAG=$$FLAG(PSORX,PSOFILL)

 ;

 ; Display message.

 ;

 I PSOFLAG="YES" D

 . W !!,"Currently, Bypass 3/4 Day Supply is set to YES."

 . W !!,"If you continue, Bypass 3/4 Day Supply will be set to NO and the 3/4"

 . W !,"Days Supply logic will apply when the RX is sent to CMOP.",!

 . Q

 E  D

 . W !!,"Currently, Bypass 3/4 Day Supply is set to NO."

 . W !!,"If you continue, Bypass 3/4 Day Supply will be set to YES and the 3/4"

 . W !,"Days Supply logic will be bypassed when the RX is sent to CMOP.",!

 . Q

 ;

 S DIR(0)="Y",DIR("A")="Continue",DIR("B")="YES"

 D ^DIR

 ;

 I Y'=1 Q

 ;

 ; Set or reset the bypass flag for this Rx/fill.

 ;

 S PSOFLAG=$S(PSOFLAG="YES":"NO",1:"YES")

 D SETFLAG(PSORX,PSOFILL,PSOFLAG)

 ;

 ; Add a comment to Activity Log.  Make the reason S(uspense) if the Rx

 ; is on the suspense queue; otherwise, make the reason E(dit).

 ;

 S PSOCOMMENT="Bypass 3/4 Day Supply set to "_PSOFLAG

 I $P($$SUSPFILL(PSORX),"^",1)="" S PSOREASON="E"

 E  S PSOREASON="S"

 D RXACT^PSOBPSU2(PSORX,PSOFILL,PSOCOMMENT,PSOREASON,DUZ)

 ;

 ; If the user flipped the flag from 'Yes' to 'No', then clear out

 ; the Suspense Hold Date.  This will cause the system to make an

 ; additional Activity Log entry the next time the 3/4 days supply

 ; check causes the prescription to be left in suspense.

 ;

 I PSOFLAG="NO" D CLRSHD(PSORX,PSOFILL)

 ;

 Q

 ;

FLAG(PSORX,PSOFILL) ; Determine how the bypass flag is currently set.

 ;

 ; This function will return the external value (YES or NO) of the

 ; Bypass 3/4 Day Supply flag for the given Rx and Fill.

 ;

 I PSOFILL=0 Q $$GET1^DIQ(52,PSORX,94,"E")

 E  Q $$GET1^DIQ(52.1,PSOFILL_","_PSORX,98,"E")

 ;

SETFLAG(PSORX,PSOFILL,PSOFLAG) ; Set the bypass flag to the value passed.

 ;

 N PSOX

 ;

 I PSOFILL=0 D

 . S PSOX(52,PSORX_",",94)=PSOFLAG

 . D FILE^DIE("E","PSOX","")

 . Q

 E  D

 . S PSOX(52.1,PSOFILL_","_PSORX_",",98)=PSOFLAG

 . D FILE^DIE("E","PSOX","")

 . Q

 ;

 Q

 ;

BYPASSOPT ; Entry point for menu option Bypass 3/4 Day Supply.

 ;

 ; The menu option Bypass 3/4 Day Supply allows the user to select one

 ; or more prescription for which the Bypass 3/4 Day Supply flag will

 ; be set.  It will also reset the Suspense Date to be today.

 ;

 N DEAD,DIC,DIR,INDT,PSOARRAY,PSOCOMMENT,PSOFILL,PSOPROMPT

 N PSORX,PSORXIEN,PSOSUSPFILL,PSOSUSPIEN,PSOX,SFN,X,Y

 ;

 W !!,"Select one or more prescriptions currently on the CMOP suspense"

 W !,"queue.  For each prescription entered, the 3/4 days Supply logic"

 W !,"will be bypassed when the CMOP process runs.  This will apply only"

 W !,"to the current fill on each ePharmacy billable prescription"

 W !,"selected.",!

 ;

 S PSOPROMPT="Select PRESCRIPTION RX #: "

 ;

B1 ;

 ;

 K DIC

 ;

 S DIC=52

 S DIC(0)="AEMQ"

 S DIC("A")=PSOPROMPT

 S DIC("T")=""

 ;

 D ^DIC

 ;

 ; If the user just hit <enter>, skip down to B2.

 ;

 I X="" G B2

 I Y=-1 G BQ

 ;

 S PSORXIEN=+Y

 S PSORX=$P(Y,"^",2)

 S PSOPROMPT="Another one: "

 ;

 ; Verify that the selected Rx is currently on the CMOP

 ; suspense queue.

 ;

 S PSOSUSPFILL=$$SUSPFILL(PSORXIEN)

 I $P(PSOSUSPFILL,"^",1)="" D  G B1

 . W !,*7,?8,"RX is not on CMOP suspense queue"

 . Q

 ;

 ; If the Rx/Fill is not e-billable, then display a message and

 ; Go back to the prompt (B1).

 ;

 I '$$EBILLABLE^PSOSULB2(PSORXIEN,$P(PSOSUSPFILL,"^",1)) D  G B1

 . W !,*7,?8,"RX is not ePharmacy billable"

 . Q

 ;

 ; If the user enters an Rx already on the list, conditionally

 ; remove it.

 ;

 I $D(PSOARRAY(PSORXIEN)) D  G B1

 . S DIR(0)="Y"

 . S DIR("A")="Remove RX "_PSORX_" from your list"

 . S DIR("B")="YES"

 . D ^DIR

 . I Y=1 K PSOARRAY(PSORXIEN)

 . Q

 ;

 ; Add the select Rx to the list.

 ;

 S PSOARRAY(PSORXIEN)=PSOSUSPFILL

 ;

 G B1

 ;

B2 ;

 ;

 I '$D(PSOARRAY) G BQ

 ;

 ; Present to the user the list of all prescriptions selected,

 ; displaying the Rx#, drug, patient name, and patient ID.

 ;

 W !!,"Prescriptions Selected:"

 ;

 S PSORXIEN=0

 F  S PSORXIEN=$O(PSOARRAY(PSORXIEN)) Q:'PSORXIEN  D

 . W !?2,$$GET1^DIQ(52,PSORXIEN,.01,"E")

 . W ?13,$E($$GET1^DIQ(52,PSORXIEN,6,"E"),1,30)

 . W ?45,$E($$GET1^DIQ(52,PSORXIEN,2,"E"),1,30)

 . Q

 ;

 W !!,"When the CMOP suspense queue is run, the 3/4 Days Supply logic"

 W !,"will be bypassed for the current fill for each ePharmacy billable"

 W !,"prescription selected.",!

 ;

 S DIR(0)="Y",DIR("A")="Continue",DIR("B")="YES"

 D ^DIR

 I Y'=1 G BQ

 ;

 W !!,?5,"Rx",?16,"Drug",?48,"Patient",?63,"New Suspense Date"

 ;

 ; For each Rx selected by the user, set the bypass flag to YES, add a

 ; comment to the activity log, reset the suspense date to be today,

 ; and call CHANGE^PSOSUCH1 to update two dates in file 52.

 ;

 S PSORXIEN=0

 F  S PSORXIEN=$O(PSOARRAY(PSORXIEN)) Q:'PSORXIEN  D

 . ;

 . S PSOFILL=$P(PSOARRAY(PSORXIEN),"^",1)

 . S PSOSUSPIEN=$P(PSOARRAY(PSORXIEN),"^",2)

 . ;

 . ; Set the bypass flag for this Rx/fill.

 . ;

 . D SETFLAG(PSORXIEN,PSOFILL,"YES")

 . ;

 . ; Add comment to Activity Log.

 . ;

 . S PSOCOMMENT="Bypass 3/4 Day Supply set to YES"

 . D RXACT^PSOBPSU2(PSORXIEN,PSOFILL,PSOCOMMENT,"S",DUZ)

 . ;

 . ; Reset the suspense date to be today (DT).

 . ;

 . S PSOX(52.5,PSOSUSPIEN_",",.02)=DT

 . D FILE^DIE("E","PSOX","")

 . ;

 . ; The call to CHANGE^PSOSUCH1, further down, updates either the Fill

 . ; Date or Refill Date field in file 52.  The input transform for

 . ; those fields causes the date to be echoed to the screen.  To

 . ; make the display of this date less confusing, we will redisplay

 . ; each Rx on a line, with the date appearing on the end.

 . ;

 . W !?2,$$GET1^DIQ(52,PSORXIEN,.01,"E")

 . W ?13,$E($$GET1^DIQ(52,PSORXIEN,6,"E"),1,30)

 . W ?45,$E($$GET1^DIQ(52,PSORXIEN,2,"E"),1,18)

 . W ?63

 . ;

 . ; CHANGE^PSOSUCH1 updates the Fill (or Refill) Date and the

 . ; Last Dispensed Date in file 52, Prescription.

 . ;

 . S SFN=PSOSUSPIEN

 . S DEAD=0

 . S INDT=DT

 . D CHANGE^PSOSUCH1(PSORXIEN,PSOFILL)

 . ;

 . Q

 ;

BQ ;

 ;

 S VALMBCK="R"

 ;

 Q

 ;

SUSPFILL(PSORX) ; Determine the fill# currently on the suspense queue.

 ;

 ; This function will determine whether a given Rx is on the suspense

 ; queue.  If it is not, or it has already been printed, or it is

 ; on the queue to be filled locally, this function returns "".

 ; Otherwise, it returns the fill# (which may be 0/zero).

 ; It also returns the IEN for the entry in file# 52.5, RX SUSPENSE.

 ;

 N PSOFILL,PSOSUSPIEN

 ;

 ; Quit with "" if this Rx is not on the suspense queue.

 ;

 S PSOSUSPIEN=$O(^PS(52.5,"B",PSORX,""))

 I PSOSUSPIEN="" Q ""

 ;

 ; Quit with "" if this Rx has already been printed.

 ;

 I $$GET1^DIQ(52.5,PSOSUSPIEN,2,"E")="YES" Q ""

 ;

 ; Quit with "" if this is a window (local) fill.

 ;

 I $$GET1^DIQ(52.5,PSOSUSPIEN,.04,"E")="WINDOW" Q ""

 ;

 ; Return the fill# and the IEN to file# 52.5, RX SUSPENSE

 ;

 Q $$GET1^DIQ(52.5,PSOSUSPIEN,9)_"^"_PSOSUSPIEN

 ;

CLRSHD(PSORX,PSOFILL) ; Clear Suspense Hold Date

 ;

 ; PSORX = Rx IEN

 ; PSOFILL = Fill #

 ;

 ; If 3/4 Bypass Flag is YES, Quit.

 ;

 I $$FLAG(PSORX,PSOFILL)="YES" Q

 ;

 ; If Rx has an entry in the Suspense file, set the

 ; SUSPENSE HOLD DATE field to nil.

 ;

 N PSOX

 S PSOX=$O(^PS(52.5,"B",PSORX,""))

 I PSOX="" Q

 S PSOX(52.5,PSOX_",",10)=""

 D FILE^DIE("","PSOX","")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOBPSU4   8367     printed  Nov 22, 2024@17:35:05                                                                                                                                                                                                    Page 2

PSOBPSU4  ;AITC/MRD - BPS (ECME) Utilities 4 ;10/29/2020

 +1       ;;7.0;OUTPATIENT PHARMACY;**561,648,703**;DEC 1997;Build 16

 +2       ;

BYPASSACT(PSORX) ; 'BY' hidden action, Bypass 3/4 Day Supply.

 +1       ;

 +2       ; The 'BY' hidden action allows the user to set a flag, BYPASS

 +3       ; 3/4 DAY SUPPLY LOGIC, which, when set, causes the 3/4 day

 +4       ; supply checks to be bypassed during CMOP processing.  If the

 +5       ; flag is already set when the user performs the 'BY' action,

 +6       ; the flag is reset to 'NO'.

 +7       ;

 +8        NEW DIR,PSOCOMMENT,PSOFILL,PSOFLAG,PSOREASON,Y

 +9       ;

 +10       DO FULL^VALM1

 +11       SET VALMBCK="R"

 +12      ;

 +13      ; Determine current fill.

 +14      ;

 +15       SET PSOFILL=$ORDER(^PSRX(PSORX,1,"A"),-1)

 +16       IF PSOFILL=""

               SET PSOFILL=0

 +17      ;

 +18      ; If the Rx/Fill is not e-billable, then display a message and

 +19      ; Quit out.

 +20      ;

 +21       IF '$$EBILLABLE^PSOSULB2(PSORX,PSOFILL)

               Begin DoDot:1

 +22               WRITE !!,*7,"***This option only applies to ePharmacy billable prescriptions***",!

 +23               SET DIR(0)="E"

                   SET DIR("A")="Press Return to Continue"

 +24               DO ^DIR

 +25               QUIT 

               End DoDot:1

               QUIT 

 +26      ;

 +27      ; Determine how the flag is currently set.

 +28      ;

 +29       SET PSOFLAG=$$FLAG(PSORX,PSOFILL)

 +30      ;

 +31      ; Display message.

 +32      ;

 +33       IF PSOFLAG="YES"

               Begin DoDot:1

 +34               WRITE !!,"Currently, Bypass 3/4 Day Supply is set to YES."

 +35               WRITE !!,"If you continue, Bypass 3/4 Day Supply will be set to NO and the 3/4"

 +36               WRITE !,"Days Supply logic will apply when the RX is sent to CMOP.",!

 +37               QUIT 

               End DoDot:1

 +38      IF '$TEST

               Begin DoDot:1

 +39               WRITE !!,"Currently, Bypass 3/4 Day Supply is set to NO."

 +40               WRITE !!,"If you continue, Bypass 3/4 Day Supply will be set to YES and the 3/4"

 +41               WRITE !,"Days Supply logic will be bypassed when the RX is sent to CMOP.",!

 +42               QUIT 

               End DoDot:1

 +43      ;

 +44       SET DIR(0)="Y"

           SET DIR("A")="Continue"

           SET DIR("B")="YES"

 +45       DO ^DIR

 +46      ;

 +47       IF Y'=1

               QUIT 

 +48      ;

 +49      ; Set or reset the bypass flag for this Rx/fill.

 +50      ;

 +51       SET PSOFLAG=$SELECT(PSOFLAG="YES":"NO",1:"YES")

 +52       DO SETFLAG(PSORX,PSOFILL,PSOFLAG)

 +53      ;

 +54      ; Add a comment to Activity Log.  Make the reason S(uspense) if the Rx

 +55      ; is on the suspense queue; otherwise, make the reason E(dit).

 +56      ;

 +57       SET PSOCOMMENT="Bypass 3/4 Day Supply set to "_PSOFLAG

 +58       IF $PIECE($$SUSPFILL(PSORX),"^",1)=""

               SET PSOREASON="E"

 +59      IF '$TEST

               SET PSOREASON="S"

 +60       DO RXACT^PSOBPSU2(PSORX,PSOFILL,PSOCOMMENT,PSOREASON,DUZ)

 +61      ;

 +62      ; If the user flipped the flag from 'Yes' to 'No', then clear out

 +63      ; the Suspense Hold Date.  This will cause the system to make an

 +64      ; additional Activity Log entry the next time the 3/4 days supply

 +65      ; check causes the prescription to be left in suspense.

 +66      ;

 +67       IF PSOFLAG="NO"

               DO CLRSHD(PSORX,PSOFILL)

 +68      ;

 +69       QUIT 

 +70      ;

FLAG(PSORX,PSOFILL) ; Determine how the bypass flag is currently set.

 +1       ;

 +2       ; This function will return the external value (YES or NO) of the

 +3       ; Bypass 3/4 Day Supply flag for the given Rx and Fill.

 +4       ;

 +5        IF PSOFILL=0

               QUIT $$GET1^DIQ(52,PSORX,94,"E")

 +6       IF '$TEST

               QUIT $$GET1^DIQ(52.1,PSOFILL_","_PSORX,98,"E")

 +7       ;

SETFLAG(PSORX,PSOFILL,PSOFLAG) ; Set the bypass flag to the value passed.

 +1       ;

 +2        NEW PSOX

 +3       ;

 +4        IF PSOFILL=0

               Begin DoDot:1

 +5                SET PSOX(52,PSORX_",",94)=PSOFLAG

 +6                DO FILE^DIE("E","PSOX","")

 +7                QUIT 

               End DoDot:1

 +8       IF '$TEST

               Begin DoDot:1

 +9                SET PSOX(52.1,PSOFILL_","_PSORX_",",98)=PSOFLAG

 +10               DO FILE^DIE("E","PSOX","")

 +11               QUIT 

               End DoDot:1

 +12      ;

 +13       QUIT 

 +14      ;

BYPASSOPT ; Entry point for menu option Bypass 3/4 Day Supply.

 +1       ;

 +2       ; The menu option Bypass 3/4 Day Supply allows the user to select one

 +3       ; or more prescription for which the Bypass 3/4 Day Supply flag will

 +4       ; be set.  It will also reset the Suspense Date to be today.

 +5       ;

 +6        NEW DEAD,DIC,DIR,INDT,PSOARRAY,PSOCOMMENT,PSOFILL,PSOPROMPT

 +7        NEW PSORX,PSORXIEN,PSOSUSPFILL,PSOSUSPIEN,PSOX,SFN,X,Y

 +8       ;

 +9        WRITE !!,"Select one or more prescriptions currently on the CMOP suspense"

 +10       WRITE !,"queue.  For each prescription entered, the 3/4 days Supply logic"

 +11       WRITE !,"will be bypassed when the CMOP process runs.  This will apply only"

 +12       WRITE !,"to the current fill on each ePharmacy billable prescription"

 +13       WRITE !,"selected.",!

 +14      ;

 +15       SET PSOPROMPT="Select PRESCRIPTION RX #: "

 +16      ;

B1        ;

 +1       ;

 +2        KILL DIC

 +3       ;

 +4        SET DIC=52

 +5        SET DIC(0)="AEMQ"

 +6        SET DIC("A")=PSOPROMPT

 +7        SET DIC("T")=""

 +8       ;

 +9        DO ^DIC

 +10      ;

 +11      ; If the user just hit <enter>, skip down to B2.

 +12      ;

 +13       IF X=""

               GOTO B2

 +14       IF Y=-1

               GOTO BQ

 +15      ;

 +16       SET PSORXIEN=+Y

 +17       SET PSORX=$PIECE(Y,"^",2)

 +18       SET PSOPROMPT="Another one: "

 +19      ;

 +20      ; Verify that the selected Rx is currently on the CMOP

 +21      ; suspense queue.

 +22      ;

 +23       SET PSOSUSPFILL=$$SUSPFILL(PSORXIEN)

 +24       IF $PIECE(PSOSUSPFILL,"^",1)=""

               Begin DoDot:1

 +25               WRITE !,*7,?8,"RX is not on CMOP suspense queue"

 +26               QUIT 

               End DoDot:1

               GOTO B1

 +27      ;

 +28      ; If the Rx/Fill is not e-billable, then display a message and

 +29      ; Go back to the prompt (B1).

 +30      ;

 +31       IF '$$EBILLABLE^PSOSULB2(PSORXIEN,$PIECE(PSOSUSPFILL,"^",1))

               Begin DoDot:1

 +32               WRITE !,*7,?8,"RX is not ePharmacy billable"

 +33               QUIT 

               End DoDot:1

               GOTO B1

 +34      ;

 +35      ; If the user enters an Rx already on the list, conditionally

 +36      ; remove it.

 +37      ;

 +38       IF $DATA(PSOARRAY(PSORXIEN))

               Begin DoDot:1

 +39               SET DIR(0)="Y"

 +40               SET DIR("A")="Remove RX "_PSORX_" from your list"

 +41               SET DIR("B")="YES"

 +42               DO ^DIR

 +43               IF Y=1

                       KILL PSOARRAY(PSORXIEN)

 +44               QUIT 

               End DoDot:1

               GOTO B1

 +45      ;

 +46      ; Add the select Rx to the list.

 +47      ;

 +48       SET PSOARRAY(PSORXIEN)=PSOSUSPFILL

 +49      ;

 +50       GOTO B1

 +51      ;

B2        ;

 +1       ;

 +2        IF '$DATA(PSOARRAY)

               GOTO BQ

 +3       ;

 +4       ; Present to the user the list of all prescriptions selected,

 +5       ; displaying the Rx#, drug, patient name, and patient ID.

 +6       ;

 +7        WRITE !!,"Prescriptions Selected:"

 +8       ;

 +9        SET PSORXIEN=0

 +10       FOR 

               SET PSORXIEN=$ORDER(PSOARRAY(PSORXIEN))

               if 'PSORXIEN

                   QUIT 

               Begin DoDot:1

 +11               WRITE !?2,$$GET1^DIQ(52,PSORXIEN,.01,"E")

 +12               WRITE ?13,$EXTRACT($$GET1^DIQ(52,PSORXIEN,6,"E"),1,30)

 +13               WRITE ?45,$EXTRACT($$GET1^DIQ(52,PSORXIEN,2,"E"),1,30)

 +14               QUIT 

               End DoDot:1

 +15      ;

 +16       WRITE !!,"When the CMOP suspense queue is run, the 3/4 Days Supply logic"

 +17       WRITE !,"will be bypassed for the current fill for each ePharmacy billable"

 +18       WRITE !,"prescription selected.",!

 +19      ;

 +20       SET DIR(0)="Y"

           SET DIR("A")="Continue"

           SET DIR("B")="YES"

 +21       DO ^DIR

 +22       IF Y'=1

               GOTO BQ

 +23      ;

 +24       WRITE !!,?5,"Rx",?16,"Drug",?48,"Patient",?63,"New Suspense Date"

 +25      ;

 +26      ; For each Rx selected by the user, set the bypass flag to YES, add a

 +27      ; comment to the activity log, reset the suspense date to be today,

 +28      ; and call CHANGE^PSOSUCH1 to update two dates in file 52.

 +29      ;

 +30       SET PSORXIEN=0

 +31       FOR 

               SET PSORXIEN=$ORDER(PSOARRAY(PSORXIEN))

               if 'PSORXIEN

                   QUIT 

               Begin DoDot:1

 +32      ;

 +33               SET PSOFILL=$PIECE(PSOARRAY(PSORXIEN),"^",1)

 +34               SET PSOSUSPIEN=$PIECE(PSOARRAY(PSORXIEN),"^",2)

 +35      ;

 +36      ; Set the bypass flag for this Rx/fill.

 +37      ;

 +38               DO SETFLAG(PSORXIEN,PSOFILL,"YES")

 +39      ;

 +40      ; Add comment to Activity Log.

 +41      ;

 +42               SET PSOCOMMENT="Bypass 3/4 Day Supply set to YES"

 +43               DO RXACT^PSOBPSU2(PSORXIEN,PSOFILL,PSOCOMMENT,"S",DUZ)

 +44      ;

 +45      ; Reset the suspense date to be today (DT).

 +46      ;

 +47               SET PSOX(52.5,PSOSUSPIEN_",",.02)=DT

 +48               DO FILE^DIE("E","PSOX","")

 +49      ;

 +50      ; The call to CHANGE^PSOSUCH1, further down, updates either the Fill

 +51      ; Date or Refill Date field in file 52.  The input transform for

 +52      ; those fields causes the date to be echoed to the screen.  To

 +53      ; make the display of this date less confusing, we will redisplay

 +54      ; each Rx on a line, with the date appearing on the end.

 +55      ;

 +56               WRITE !?2,$$GET1^DIQ(52,PSORXIEN,.01,"E")

 +57               WRITE ?13,$EXTRACT($$GET1^DIQ(52,PSORXIEN,6,"E"),1,30)

 +58               WRITE ?45,$EXTRACT($$GET1^DIQ(52,PSORXIEN,2,"E"),1,18)

 +59               WRITE ?63

 +60      ;

 +61      ; CHANGE^PSOSUCH1 updates the Fill (or Refill) Date and the

 +62      ; Last Dispensed Date in file 52, Prescription.

 +63      ;

 +64               SET SFN=PSOSUSPIEN

 +65               SET DEAD=0

 +66               SET INDT=DT

 +67               DO CHANGE^PSOSUCH1(PSORXIEN,PSOFILL)

 +68      ;

 +69               QUIT 

               End DoDot:1

 +70      ;

BQ        ;

 +1       ;

 +2        SET VALMBCK="R"

 +3       ;

 +4        QUIT 

 +5       ;

SUSPFILL(PSORX) ; Determine the fill# currently on the suspense queue.

 +1       ;

 +2       ; This function will determine whether a given Rx is on the suspense

 +3       ; queue.  If it is not, or it has already been printed, or it is

 +4       ; on the queue to be filled locally, this function returns "".

 +5       ; Otherwise, it returns the fill# (which may be 0/zero).

 +6       ; It also returns the IEN for the entry in file# 52.5, RX SUSPENSE.

 +7       ;

 +8        NEW PSOFILL,PSOSUSPIEN

 +9       ;

 +10      ; Quit with "" if this Rx is not on the suspense queue.

 +11      ;

 +12       SET PSOSUSPIEN=$ORDER(^PS(52.5,"B",PSORX,""))

 +13       IF PSOSUSPIEN=""

               QUIT ""

 +14      ;

 +15      ; Quit with "" if this Rx has already been printed.

 +16      ;

 +17       IF $$GET1^DIQ(52.5,PSOSUSPIEN,2,"E")="YES"

               QUIT ""

 +18      ;

 +19      ; Quit with "" if this is a window (local) fill.

 +20      ;

 +21       IF $$GET1^DIQ(52.5,PSOSUSPIEN,.04,"E")="WINDOW"

               QUIT ""

 +22      ;

 +23      ; Return the fill# and the IEN to file# 52.5, RX SUSPENSE

 +24      ;

 +25       QUIT $$GET1^DIQ(52.5,PSOSUSPIEN,9)_"^"_PSOSUSPIEN

 +26      ;

CLRSHD(PSORX,PSOFILL) ; Clear Suspense Hold Date

 +1       ;

 +2       ; PSORX = Rx IEN

 +3       ; PSOFILL = Fill #

 +4       ;

 +5       ; If 3/4 Bypass Flag is YES, Quit.

 +6       ;

 +7        IF $$FLAG(PSORX,PSOFILL)="YES"

               QUIT 

 +8       ;

 +9       ; If Rx has an entry in the Suspense file, set the

 +10      ; SUSPENSE HOLD DATE field to nil.

 +11      ;

 +12       NEW PSOX

 +13       SET PSOX=$ORDER(^PS(52.5,"B",PSORX,""))

 +14       IF PSOX=""

               QUIT 

 +15       SET PSOX(52.5,PSOX_",",10)=""

 +16       DO FILE^DIE("","PSOX","")

 +17       QUIT