- PSOSPMU2 ;BIRM/MFR - State Prescription Monitoring Program Utility #2 - Prompts ;10/07/15
- ;;7.0;OUTPATIENT PHARMACY;**451,625**;DEC 1997;Build 42
- ;
- ASAPVER(DEFTYPE,REGZERO,DSPHLP,DEFAULT,REQUIRED,ALLOWDEL) ; Prompt for the ASAP Version
- ; Input: (r) DEFTYPE - ASAP Definition Type (S: Standard Only; C: Customized Only, F: Fully Customized Only,
- ; A: All. A combination is also allowed, e.g., "CF")
- ; (r) REGZERO - Regular or Zero Report or Both ASAP Definitions (R: Regular Only; Z: Zero Report Only;
- ; B: Both) ;adding new parameter for Zero Report
- ; (o) DSPHLP - Display Help before prompting? (1: YES / 0: NO)
- ; (o) DEFAULT - Default ASAP Version
- ; (o) REQUIRED - Is Answer Required? (1: YES / 0: NO)
- ; (o) ALLOWDEL - Allow delete? (accepts "@" as a valid input)
- ;Output: ASAPVER - ASAP Version, "^", "@" or ""
- N DIR,X,Y,DTOUT,DIRUT,VERLST
- ;
- ASK1 ; Label used in case the prompt needs to be asked again
- D VERLIST^PSOSPMU0(DEFTYPE,REGZERO,.VERLST) ;Zero Report adding REGZERO
- ;K DIR S DIR(0)="FO^1:10",DIR("A")="ASAP VERSION" S:$G(DEFAULT)'="" DIR("B")=DEFAULT ;Zero Report
- I REGZERO'["Z" D
- . K DIR S DIR(0)="FO^1:10",DIR("A")="ASAP VERSION" S:$G(DEFAULT)'="" DIR("B")=DEFAULT
- E D
- . K DIR S DIR(0)="FO^1:10",DIR("A")="ZERO REPORT ASAP VERSION" S:$G(DEFAULT)'="" DIR("B")=DEFAULT
- ;
- S DIR("?")="^D HLP1^PSOSPMU2(.VERLST)" I $G(DSPHLP) D HLP1^PSOSPMU2(.VERLST)
- D ^DIR
- I '$G(REQUIRED),X="" Q X
- I $G(ALLOWDEL),X="@" Q X
- I $G(REQUIRED),(X=""!(X="@")) W !,"This is a required response. Enter '^' to exit",$C(7),! G ASK1
- I $D(DIRUT)!$D(DTOUT) Q "^"
- I '$D(VERLST(X_" ")) W ?40,"Invalid ASAP Version",$C(7),! G ASK1
- Q X
- ;
- HLP1(VERLST) ; Help Text for ASAP Version prompt and Zero Report ASAP Version prompt
- ;Input: (r) VERLST - Array containing a list ASAP versions
- N VER,HLPLN
- I REGZERO["Z" D Q ;start Zero Report ASAP display
- . W !?5,"American Society for Automation in Pharmacy (ASAP) Version for Zero"
- . W !?5,"Reporting to the State (no prescription fills to report). Leave blank"
- . W !?5,"if the state does not require Zero Reporting."
- . W !!?5,"Select one of the following:"
- . W !
- . S VER="" F S VER=$O(VERLST(VER)) Q:VER="" D
- . . S HLPLN="",$E(HLPLN,11)=VER,$E(HLPLN,22)="ASAP Version "_$E(VER,1,$L(VER)-1)_$S(VERLST(VER)="FZ":"*",1:"")_" (Zero Report)"
- . . W !,HLPLN
- . W !
- ;
- W !?5,"American Society for Automation in Pharmacy (ASAP) Version"
- W !!?5,"Select one of the following:"
- W !
- S VER="" F S VER=$O(VERLST(VER)) Q:VER="" D
- . S HLPLN="",$E(HLPLN,11)=VER,$E(HLPLN,22)="ASAP Version "_$E(VER,1,$L(VER)-1)_$S(VERLST(VER)="F":"*",1:"")
- . I VERLST(VER)["FZ" S HLPLN="",$E(HLPLN,11)=VER,$E(HLPLN,22)="ASAP Version "_$E(VER,1,$L(VER)-1)_"*"_" (Zero Report)"
- . I VERLST(VER)["SZ" S HLPLN=HLPLN_" (Zero Report)" ;adding Zero Report display
- . W !,HLPLN
- W !
- Q
- ;
- RXFILL(RXIEN) ; Select Prescription Fill #
- ;Input: (r) RXIEN - Pointer to the PRESCRIPTION file (#52)
- N RXFILL,DIR,I,Y,DIRUT,DTOUT,FILLARR,RTSFILL,RTSFLDT
- S RXFILL=0,FILLARR(0)=""
- K DIR S DIR("A")=" Fill",DIR("B")=0
- S DIR(0)="S^0:Original ("_$$FMTE^XLFDT($$RXFLDT^PSOBPSUT(RXIEN,0),2)_") "_$$MWA(RXIEN,0)
- F I=1:1 Q:'$D(^PSRX(RXIEN,1,I)) D
- . S DIR(0)=DIR(0)_";"_I_":Refill "_I_" ("_$$FMTE^XLFDT($$RXFLDT^PSOBPSUT(RXIEN,I),2)_") "_$$MWA(RXIEN,I),FILLARR(I)=""
- F I=1:1 Q:'$D(^PSRX(RXIEN,"P",I)) D
- . S DIR(0)=DIR(0)_";P"_I_":Partial "_I_" ("_$$FMTE^XLFDT($$RXFLDT^PSOBPSUT(RXIEN,"P"_I),2)_") "_$$MWA(RXIEN,"P"_I),FILLARR("P"_I)=""
- F I=1:1 Q:'$D(^PSRX(RXIEN,"RTS",I)) D
- . S RTSFILL=$P(^PSRX(RXIEN,"RTS",I,0),"^",2) Q:RTSFILL="" I $D(FILLARR(RTSFILL)) Q
- . S RTSFLDT=$P(^PSRX(RXIEN,"RTS",I,0),"^",3)
- . S FILLARR(RTSFILL)=""
- . S DIR(0)=DIR(0)_";"_RTSFILL_":"_$S(RTSFILL["P":"Partial "_$E(RTSFILL,2,9),1:"Refill "_RTSFILL)_" ("_$$FMTE^XLFDT(RTSFLDT,2)_") "_$$MWA(RXIEN,RTSFILL)
- D ^DIR I $D(DIRUT)!$D(DTOUT) Q "^"
- S RXFILL=$G(Y)
- Q RXFILL
- ;
- MWA(RXIEN,FILL) ; Returns the Rx delivering (WINDOW/MAIL/ADMIN IN CLINIC)
- ;Input: (r) RXIEN - Pointer to the PRESCRIPTION file (#52)
- ; (r) FILL - Rx Fill # (0:Original, 1:Refill #1,...,"P1":Partial #1, etc....)
- I FILL["P" Q $$GET1^DIQ(52.2,$E(FILL,2,3)_","_RXIEN,.02)
- I FILL Q:$$GET1^DIQ(52.1,FILL_","_RXIEN,23,"I") "ADMIN IN CLINIC" Q $$GET1^DIQ(52.1,FILL_","_RXIEN,2)
- Q:$$GET1^DIQ(52,RXIEN,14,"I") "ADMIN IN CLINIC"
- Q $$GET1^DIQ(52,RXIEN,11)
- ;
- ASAPHELP(AVER,ASEG,AFLD) ; SPMP Help Text
- ; Retrieve ASAP text definition/description from SPMP ASAP RECORD DEFINITION file (#58.4)
- ; INPUT: AVER = ASAP Version
- ; ASEG = ASAP Segment
- ; AFLD = ASAP Field
- ;
- N ASAP,LN
- Q:$G(AVER)=""!($G(ASEG)="")!($G(AFLD)="")
- D LOADASAP^PSOSPMU0(AVER,"B",.ASAP)
- S LN=0 F S LN=$O(ASAP(ASEG,AFLD,"DES",LN)) Q:'LN D
- .N TXT S TXT=$$UP^XLFSTR($G(ASAP(ASEG,AFLD,"DES",LN)))
- .W ! I $E(TXT,1,3)=" 0" W $S(TXT["NEW":" N -",TXT["CHANGE":" R -",TXT["CANCEL":" V -",TXT]"VOID":" V",1:" ")
- .W ASAP(ASEG,AFLD,"DES",LN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPMU2 5112 printed Jan 18, 2025@03:36:21 Page 2
- PSOSPMU2 ;BIRM/MFR - State Prescription Monitoring Program Utility #2 - Prompts ;10/07/15
- +1 ;;7.0;OUTPATIENT PHARMACY;**451,625**;DEC 1997;Build 42
- +2 ;
- ASAPVER(DEFTYPE,REGZERO,DSPHLP,DEFAULT,REQUIRED,ALLOWDEL) ; Prompt for the ASAP Version
- +1 ; Input: (r) DEFTYPE - ASAP Definition Type (S: Standard Only; C: Customized Only, F: Fully Customized Only,
- +2 ; A: All. A combination is also allowed, e.g., "CF")
- +3 ; (r) REGZERO - Regular or Zero Report or Both ASAP Definitions (R: Regular Only; Z: Zero Report Only;
- +4 ; B: Both) ;adding new parameter for Zero Report
- +5 ; (o) DSPHLP - Display Help before prompting? (1: YES / 0: NO)
- +6 ; (o) DEFAULT - Default ASAP Version
- +7 ; (o) REQUIRED - Is Answer Required? (1: YES / 0: NO)
- +8 ; (o) ALLOWDEL - Allow delete? (accepts "@" as a valid input)
- +9 ;Output: ASAPVER - ASAP Version, "^", "@" or ""
- +10 NEW DIR,X,Y,DTOUT,DIRUT,VERLST
- +11 ;
- ASK1 ; Label used in case the prompt needs to be asked again
- +1 ;Zero Report adding REGZERO
- DO VERLIST^PSOSPMU0(DEFTYPE,REGZERO,.VERLST)
- +2 ;K DIR S DIR(0)="FO^1:10",DIR("A")="ASAP VERSION" S:$G(DEFAULT)'="" DIR("B")=DEFAULT ;Zero Report
- +3 IF REGZERO'["Z"
- Begin DoDot:1
- +4 KILL DIR
- SET DIR(0)="FO^1:10"
- SET DIR("A")="ASAP VERSION"
- if $GET(DEFAULT)'=""
- SET DIR("B")=DEFAULT
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 KILL DIR
- SET DIR(0)="FO^1:10"
- SET DIR("A")="ZERO REPORT ASAP VERSION"
- if $GET(DEFAULT)'=""
- SET DIR("B")=DEFAULT
- End DoDot:1
- +7 ;
- +8 SET DIR("?")="^D HLP1^PSOSPMU2(.VERLST)"
- IF $GET(DSPHLP)
- DO HLP1^PSOSPMU2(.VERLST)
- +9 DO ^DIR
- +10 IF '$GET(REQUIRED)
- IF X=""
- QUIT X
- +11 IF $GET(ALLOWDEL)
- IF X="@"
- QUIT X
- +12 IF $GET(REQUIRED)
- IF (X=""!(X="@"))
- WRITE !,"This is a required response. Enter '^' to exit",$CHAR(7),!
- GOTO ASK1
- +13 IF $DATA(DIRUT)!$DATA(DTOUT)
- QUIT "^"
- +14 IF '$DATA(VERLST(X_" "))
- WRITE ?40,"Invalid ASAP Version",$CHAR(7),!
- GOTO ASK1
- +15 QUIT X
- +16 ;
- HLP1(VERLST) ; Help Text for ASAP Version prompt and Zero Report ASAP Version prompt
- +1 ;Input: (r) VERLST - Array containing a list ASAP versions
- +2 NEW VER,HLPLN
- +3 ;start Zero Report ASAP display
- IF REGZERO["Z"
- Begin DoDot:1
- +4 WRITE !?5,"American Society for Automation in Pharmacy (ASAP) Version for Zero"
- +5 WRITE !?5,"Reporting to the State (no prescription fills to report). Leave blank"
- +6 WRITE !?5,"if the state does not require Zero Reporting."
- +7 WRITE !!?5,"Select one of the following:"
- +8 WRITE !
- +9 SET VER=""
- FOR
- SET VER=$ORDER(VERLST(VER))
- if VER=""
- QUIT
- Begin DoDot:2
- +10 SET HLPLN=""
- SET $EXTRACT(HLPLN,11)=VER
- SET $EXTRACT(HLPLN,22)="ASAP Version "_$EXTRACT(VER,1,$LENGTH(VER)-1)_$SELECT(VERLST(VER)="FZ":"*",1:"")_" (Zero Report)"
- +11 WRITE !,HLPLN
- End DoDot:2
- +12 WRITE !
- End DoDot:1
- QUIT
- +13 ;
- +14 WRITE !?5,"American Society for Automation in Pharmacy (ASAP) Version"
- +15 WRITE !!?5,"Select one of the following:"
- +16 WRITE !
- +17 SET VER=""
- FOR
- SET VER=$ORDER(VERLST(VER))
- if VER=""
- QUIT
- Begin DoDot:1
- +18 SET HLPLN=""
- SET $EXTRACT(HLPLN,11)=VER
- SET $EXTRACT(HLPLN,22)="ASAP Version "_$EXTRACT(VER,1,$LENGTH(VER)-1)_$SELECT(VERLST(VER)="F":"*",1:"")
- +19 IF VERLST(VER)["FZ"
- SET HLPLN=""
- SET $EXTRACT(HLPLN,11)=VER
- SET $EXTRACT(HLPLN,22)="ASAP Version "_$EXTRACT(VER,1,$LENGTH(VER)-1)_"*"_" (Zero Report)"
- +20 ;adding Zero Report display
- IF VERLST(VER)["SZ"
- SET HLPLN=HLPLN_" (Zero Report)"
- +21 WRITE !,HLPLN
- End DoDot:1
- +22 WRITE !
- +23 QUIT
- +24 ;
- RXFILL(RXIEN) ; Select Prescription Fill #
- +1 ;Input: (r) RXIEN - Pointer to the PRESCRIPTION file (#52)
- +2 NEW RXFILL,DIR,I,Y,DIRUT,DTOUT,FILLARR,RTSFILL,RTSFLDT
- +3 SET RXFILL=0
- SET FILLARR(0)=""
- +4 KILL DIR
- SET DIR("A")=" Fill"
- SET DIR("B")=0
- +5 SET DIR(0)="S^0:Original ("_$$FMTE^XLFDT($$RXFLDT^PSOBPSUT(RXIEN,0),2)_") "_$$MWA(RXIEN,0)
- +6 FOR I=1:1
- if '$DATA(^PSRX(RXIEN,1,I))
- QUIT
- Begin DoDot:1
- +7 SET DIR(0)=DIR(0)_";"_I_":Refill "_I_" ("_$$FMTE^XLFDT($$RXFLDT^PSOBPSUT(RXIEN,I),2)_") "_$$MWA(RXIEN,I)
- SET FILLARR(I)=""
- End DoDot:1
- +8 FOR I=1:1
- if '$DATA(^PSRX(RXIEN,"P",I))
- QUIT
- Begin DoDot:1
- +9 SET DIR(0)=DIR(0)_";P"_I_":Partial "_I_" ("_$$FMTE^XLFDT($$RXFLDT^PSOBPSUT(RXIEN,"P"_I),2)_") "_$$MWA(RXIEN,"P"_I)
- SET FILLARR("P"_I)=""
- End DoDot:1
- +10 FOR I=1:1
- if '$DATA(^PSRX(RXIEN,"RTS",I))
- QUIT
- Begin DoDot:1
- +11 SET RTSFILL=$PIECE(^PSRX(RXIEN,"RTS",I,0),"^",2)
- if RTSFILL=""
- QUIT
- IF $DATA(FILLARR(RTSFILL))
- QUIT
- +12 SET RTSFLDT=$PIECE(^PSRX(RXIEN,"RTS",I,0),"^",3)
- +13 SET FILLARR(RTSFILL)=""
- +14 SET DIR(0)=DIR(0)_";"_RTSFILL_":"_$SELECT(RTSFILL["P":"Partial "_$EXTRACT(RTSFILL,2,9),1:"Refill "_RTSFILL)_" ("_$$FMTE^XLFDT(RTSFLDT,2)_") "_$$MWA(RXIEN,RTSFILL)
- End DoDot:1
- +15 DO ^DIR
- IF $DATA(DIRUT)!$DATA(DTOUT)
- QUIT "^"
- +16 SET RXFILL=$GET(Y)
- +17 QUIT RXFILL
- +18 ;
- MWA(RXIEN,FILL) ; Returns the Rx delivering (WINDOW/MAIL/ADMIN IN CLINIC)
- +1 ;Input: (r) RXIEN - Pointer to the PRESCRIPTION file (#52)
- +2 ; (r) FILL - Rx Fill # (0:Original, 1:Refill #1,...,"P1":Partial #1, etc....)
- +3 IF FILL["P"
- QUIT $$GET1^DIQ(52.2,$EXTRACT(FILL,2,3)_","_RXIEN,.02)
- +4 IF FILL
- if $$GET1^DIQ(52.1,FILL_","_RXIEN,23,"I")
- QUIT "ADMIN IN CLINIC"
- QUIT $$GET1^DIQ(52.1,FILL_","_RXIEN,2)
- +5 if $$GET1^DIQ(52,RXIEN,14,"I")
- QUIT "ADMIN IN CLINIC"
- +6 QUIT $$GET1^DIQ(52,RXIEN,11)
- +7 ;
- ASAPHELP(AVER,ASEG,AFLD) ; SPMP Help Text
- +1 ; Retrieve ASAP text definition/description from SPMP ASAP RECORD DEFINITION file (#58.4)
- +2 ; INPUT: AVER = ASAP Version
- +3 ; ASEG = ASAP Segment
- +4 ; AFLD = ASAP Field
- +5 ;
- +6 NEW ASAP,LN
- +7 if $GET(AVER)=""!($GET(ASEG)="")!($GET(AFLD)="")
- QUIT
- +8 DO LOADASAP^PSOSPMU0(AVER,"B",.ASAP)
- +9 SET LN=0
- FOR
- SET LN=$ORDER(ASAP(ASEG,AFLD,"DES",LN))
- if 'LN
- QUIT
- Begin DoDot:1
- +10 NEW TXT
- SET TXT=$$UP^XLFSTR($GET(ASAP(ASEG,AFLD,"DES",LN)))
- +11 WRITE !
- IF $EXTRACT(TXT,1,3)=" 0"
- WRITE $SELECT(TXT["NEW":" N -",TXT["CHANGE":" R -",TXT["CANCEL":" V -",TXT]"VOID":" V",1:" ")
- +12 WRITE ASAP(ASEG,AFLD,"DES",LN)
- End DoDot:1
- +13 QUIT