- 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 Feb 19, 2025@00:01:32 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
