PSOSPML6 ;BIRM/MFR - Unmark Rx Fill as 'Administered in Clinic' ;09/30/13
;;7.0;OUTPATIENT PHARMACY;**408,451**;DEC 1997;Build 114
;
N DIR,DIRUT,X,PSOQUIT,RXIEN,RXFILL,BATIEN,STATEIEN
RX ; - Prescription prompt
K DIR S DIR(0)="FAO^1:30",DIR("A")=" PRESCRIPTION: ",(DIR("?"),DIR("??"))="^D HLP^PSORXVW1"
W ! D ^DIR I X=""!$D(DIRUT) G EXIT
S X=$$UP^XLFSTR(X),PSOQUIT=0
I $E(X,1,2)'="E." S RXIEN=+$$RXLKP(X) I RXIEN<0 G RX
I $E(X,1,2)="E." D I PSOQUIT G RX
. I $L(X)'=9 W !?5,"The ECME# must be 7 digits long!",$C(7) S PSOQUIT=1 Q
. S RXIEN=+$$RXNUM^PSOBPSU2($E(X,3,9)) I RXIEN<0 W " ??" S PSOQUIT=1
;
S RXFILL=$$RXFILL^PSOSPMU2(RXIEN) I RXFILL="^" G EXIT
;
I '$$ADMCLN^PSOSPMUT(RXIEN,RXFILL) D G RX
. W !!," Prescription Fill not marked as 'Administered in Clinic'.",$C(7)
;
W ! K DIR,DTOUT,DUOUT
S DIR("A")="Unmark prescription fill as 'Administered in Clinic'",DIR("A",2)=""
S DIR(0)="Y",DIR("B")="N" D ^DIR I $G(DTOUT)!$G(DUOUT)!'Y Q
;
N DIE,DR,DA W !!,"Updating Rx..."
I 'RXFILL D
. S DIE="^PSRX(",DA=RXIEN,DR="14///@"
E D
. S DIE="^PSRX("_RXIEN_",1,",DA(1)=RXIEN,DA=RXFILL,DR="23///@"
D ^DIE H 2 W "done.",$C(7)
;
I '$$RXRLDT^PSOBPSUT(RXIEN,RXFILL) G RX
;
W ! K DIR
S DIR("A")="Transmit Prescription Fill to the State",DIR(0)="Y",DIR("B")="N"
D ^DIR I $G(DTOUT)!$G(DUOUT)!'Y G RX
;
S STATEIEN=$$RXSTATE^PSOBPSUT(RXIEN,0)
K ^TMP("PSOSPMRX",$J) S ^TMP("PSOSPMRX",$J,STATEIEN,RXIEN,RXFILL)="N"
S BATIEN=$$BLDBAT^PSOSPMU1("RX")
D EXPORT^PSOSPMUT(BATIEN,"EXPORT")
;
G RX
;
EXIT Q
;
RXLKP(RXNUM) ; - Peforms Lookup on the PRESCRIPTION file
N DIC,X,Y,D
S DIC="^PSRX(",DIC(0)="QE",D="B",X=RXNUM
D IX^DIC
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPML6 1700 printed Sep 23, 2025@20:11:33 Page 2
PSOSPML6 ;BIRM/MFR - Unmark Rx Fill as 'Administered in Clinic' ;09/30/13
+1 ;;7.0;OUTPATIENT PHARMACY;**408,451**;DEC 1997;Build 114
+2 ;
+3 NEW DIR,DIRUT,X,PSOQUIT,RXIEN,RXFILL,BATIEN,STATEIEN
RX ; - Prescription prompt
+1 KILL DIR
SET DIR(0)="FAO^1:30"
SET DIR("A")=" PRESCRIPTION: "
SET (DIR("?"),DIR("??"))="^D HLP^PSORXVW1"
+2 WRITE !
DO ^DIR
IF X=""!$DATA(DIRUT)
GOTO EXIT
+3 SET X=$$UP^XLFSTR(X)
SET PSOQUIT=0
+4 IF $EXTRACT(X,1,2)'="E."
SET RXIEN=+$$RXLKP(X)
IF RXIEN<0
GOTO RX
+5 IF $EXTRACT(X,1,2)="E."
Begin DoDot:1
+6 IF $LENGTH(X)'=9
WRITE !?5,"The ECME# must be 7 digits long!",$CHAR(7)
SET PSOQUIT=1
QUIT
+7 SET RXIEN=+$$RXNUM^PSOBPSU2($EXTRACT(X,3,9))
IF RXIEN<0
WRITE " ??"
SET PSOQUIT=1
End DoDot:1
IF PSOQUIT
GOTO RX
+8 ;
+9 SET RXFILL=$$RXFILL^PSOSPMU2(RXIEN)
IF RXFILL="^"
GOTO EXIT
+10 ;
+11 IF '$$ADMCLN^PSOSPMUT(RXIEN,RXFILL)
Begin DoDot:1
+12 WRITE !!," Prescription Fill not marked as 'Administered in Clinic'.",$CHAR(7)
End DoDot:1
GOTO RX
+13 ;
+14 WRITE !
KILL DIR,DTOUT,DUOUT
+15 SET DIR("A")="Unmark prescription fill as 'Administered in Clinic'"
SET DIR("A",2)=""
+16 SET DIR(0)="Y"
SET DIR("B")="N"
DO ^DIR
IF $GET(DTOUT)!$GET(DUOUT)!'Y
QUIT
+17 ;
+18 NEW DIE,DR,DA
WRITE !!,"Updating Rx..."
+19 IF 'RXFILL
Begin DoDot:1
+20 SET DIE="^PSRX("
SET DA=RXIEN
SET DR="14///@"
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 SET DIE="^PSRX("_RXIEN_",1,"
SET DA(1)=RXIEN
SET DA=RXFILL
SET DR="23///@"
End DoDot:1
+23 DO ^DIE
HANG 2
WRITE "done.",$CHAR(7)
+24 ;
+25 IF '$$RXRLDT^PSOBPSUT(RXIEN,RXFILL)
GOTO RX
+26 ;
+27 WRITE !
KILL DIR
+28 SET DIR("A")="Transmit Prescription Fill to the State"
SET DIR(0)="Y"
SET DIR("B")="N"
+29 DO ^DIR
IF $GET(DTOUT)!$GET(DUOUT)!'Y
GOTO RX
+30 ;
+31 SET STATEIEN=$$RXSTATE^PSOBPSUT(RXIEN,0)
+32 KILL ^TMP("PSOSPMRX",$JOB)
SET ^TMP("PSOSPMRX",$JOB,STATEIEN,RXIEN,RXFILL)="N"
+33 SET BATIEN=$$BLDBAT^PSOSPMU1("RX")
+34 DO EXPORT^PSOSPMUT(BATIEN,"EXPORT")
+35 ;
+36 GOTO RX
+37 ;
EXIT QUIT
+1 ;
RXLKP(RXNUM) ; - Peforms Lookup on the PRESCRIPTION file
+1 NEW DIC,X,Y,D
+2 SET DIC="^PSRX("
SET DIC(0)="QE"
SET D="B"
SET X=RXNUM
+3 DO IX^DIC
+4 QUIT Y
