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 Apr 09, 2024@21:30:03 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
