APSPUTIL ;IHS/BAO/DMH - Utilites to Support OP v7.0 -;01-Oct-2012 12:40;PLS
;;7.0;IHS PHARMACY MODIFICATIONS;**1006,1007,1009,1011,1015**;Sep 23, 2004;Build 62
;
PMS ; EP ; called from PSORXL before go in to print the label 3/1/2002
S DIR("A")="Do you want to print a Patient Med Sheet"
S DIR("B")="N"
S DIR(0)="Y"
S DIR("?")="Please enter Y OR N to print Patient Medication Sheet Also"
D ^DIR
Q:$D(DIRUT)
I Y=0 K DIR Q
K DIR
;
S APSQSTOP=0
; need DFN set and PPL
S PPL=$G(PSORX("PSOL",1))
D EN^APSEPPIM
Q
;
; Prompt for a date range.
; .APSPB Start date in FM format (returned)
; .APSPE End date in FM format (returned)
; .APSPPOP Abort flag (returned)
; APSPBDF Default begin date (optional)
; APSPEDF Default end date (optional)
; APSPSAME If nonzero, default end date is begin date (optional)
; APSPTIME If nonzero, ask for time (optional)
;
ASKDATES(APSPB,APSPE,APSPPOP,APSPBDF,APSPEDF,APSPSAME,APSPTIME) ; EP
N APSPOPT
W !!," *** Date Range Selection ***"
S APSPPOP=0,APSPOPT=$S($G(APSPTIME):"T",1:"")
S APSPB=$$ASKDATE(" Begin with DATE: ",.APSPBDF,,APSPOPT)
S:'APSPPOP APSPE=$$ASKDATE(" End with DATE: ",$S($G(APSPSAME):APSPB,$G(APSPEDF):APSPEDF,1:""),APSPB,APSPOPT)
Q
; Prompt for single date date
; APSPPMT = Prompt
; APSPDFL = Default value (optional)
; APSPMIN = Minimum value (optional)
; APSPOPT = Additional options (optional)
ASKDATE(APSPPMT,APSPDFL,APSPMIN,APSPOPT) ;
N %DT,Y
S %DT="APEX"_$G(APSPOPT)
S %DT("A")=APSPPMT
S:$G(APSPMIN) %DT(0)=APSPMIN
I $G(APSPDFL) D
.S Y=APSPDFL
.D DD^%DT
.S %DT("B")=Y
D ^%DT
S:Y<0 APSPPOP=1
Q Y
;
; DIR call for required Y/N response
DIRYNR(APSPPMT,APSPDFL,APSPHLP,APSPPOP) ; EP
N Y
S Y=$$DIR("Y",.APSPPMT,.APSPDFL,.APSPHLP,.APSPPOP)
Q Y
; DIR call for Y/N response
DIRYN(APSPPMT,APSPDFL,APSPHLP,APSPPOP) ; EP
N Y
S Y=$$DIR("YO",.APSPPMT,.APSPDFL,.APSPHLP,.APSPPOP)
Q Y
; Paramerized DIR call
DIR(APSPDTP,APSPPMT,APSPDFL,APSPHLP,APSPPOP,APSPSCN) ; EP
N DIR,DTOUT,DUOUT,Y
S DIR(0)=APSPDTP,DIR("B")=$G(APSPDFL)
I '$G(APSPPMT) M DIR("A")=APSPPMT
E D GETTEXT(APSPPMT,$NA(DIR("A")))
I '$G(APSPHLP) M DIR("?")=APSPHLP
E D GETTEXT(APSPHLP,$NA(DIR("?")))
S:$L($G(APSPSCN)) DIR("S")=APSPSCN
D ^DIR
S:$D(DUOUT)!$D(DTOUT) APSPPOP=1
Q Y
; Pause for user input
DIRZ(APSPPMT) ; EP
D DIR("E",.APSPPMT,,,.APSPPOP)
Q
; Load dialog text into array
; APSPDG = Dialog index^optional parameters
; APSPAR = Array to receive text
GETTEXT(APSPDG,APSPAR) ;
N APSPPM
K @APSPAR
F X=2:1:$L(APSPDG,U) S APSPPM(X-1)=$P(APSPDG,U,X)
S APSPDG=$S(APSPDG<0:-APSPDG,1:+APSPDG)
D BLD^DIALOG(APSPDG/1000+59000,.APSPPM,,APSPAR)
Q
;
; Prompt for entry from file
; APSPFILE = File #
; APSPPMPT = Prompt
; APSPPOP = Abort Flag (returned)
; APSPDIC0 = Additional DIC(0) parameters
GETIEN(APSPFILE,APSPPMPT,APSPPOP,APSPDIC0) ; EP
N DIC,APSPD,Y
S APSPPOP=0
S APSPD=$$GET1^DIQ(APSPFILE,$$FIND1^DIC(APSPFILE,,," "),.01)
S DIC=APSPFILE,DIC(0)="AE"_$G(APSPDIC0),DIC("A")=$G(APSPPMPT),DIC("B")=APSPD
D ^DIC
S:Y'>0 APSPPOP=1
Q +Y
; Prompt for entry from file
; APSPFILE = File #
; APSPPMPT = Prompt
; APSPDFLD = Field whose value is to be used for default value
; Set to -1 for no default value
; D - x-ref (C^D)
; APSPSCRN = DIC("S") SCREEN LOGIC
; APSPDFLT = Default value set in DIC("B") - not used if APSPDFLD is >0
GETIEN1(APSPFILE,APSPPMPT,APSPDFLD,D,APSPSCRN,APSPDFLT) ; EP
N DIC,APSPD,Y
S D=$G(D,"B")
S:'$L(D) D="B"
S APSPDFLD=$G(APSPDFLD,.01)
S APSPD=""
S DIC("S")=$G(APSPSCRN)
S:APSPDFLD>0 APSPD=$$GET1^DIQ(APSPFILE,$$FIND1^DIC(APSPFILE,,," ",.D,DIC("S")),APSPDFLD)
I APSPDFLD<0,$L($G(APSPDFLT)) S APSPD=APSPDFLT
S DIC=APSPFILE,DIC(0)="AE",DIC("A")=$G(APSPPMPT),DIC("B")=APSPD
I $L(D,U)>1,DIC(0)'["M" S DIC(0)=DIC(0)_"M"
D MIX^DIC1
S:Y'>0 APSPPOP=1,$P(APSPPOP,U,2)=X="@"
Q +Y
; Display required header for menus
TITLE(PKG,VER) ;EP
Q:$E($G(IOST),1,2)'="C-"
N X,%ZIS,IORVON,IORVOFF,MNU
S MNU=$P(XQY0,U,2),VER="Version "_$G(VER,1.1),PKG=$G(PKG,"RPMS-EHR Management")
S X="IORVON;IORVOFF"
D ENDR^%ZISS
U IO
W @IOF,IORVON,$$GET1^DIQ(4,DUZ(2),.01),?(IOM-$L(PKG)\2),PKG,?(IOM-$L(VER)),VER,!,IORVOFF,?(IOM-$L(MNU)\2-$X),MNU
Q
; Edit a parameter from a menu option
EDITPAR(PARAM) ;EP
S PARAM=$G(PARAM,$P(XQY0,U))
D TITLE(),EDITPAR^XPAREDIT(PARAM):$$CHECK(8989.51,PARAM,"Parameter")
Q
; Check to make sure entry exists
CHECK(FIL,VAL,ENT) ;
Q:$$FIND1^DIC(FIL,,"X",VAL) 1
W !,ENT," ",VAL," was not found.",!
D DIRZ
Q 0
APSPUTIL ;IHS/BAO/DMH - Utilites to Support OP v7.0 -;01-Oct-2012 12:40;PLS
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1006,1007,1009,1011,1015**;Sep 23, 2004;Build 62
+2 ;
PMS ; EP ; called from PSORXL before go in to print the label 3/1/2002
+1 SET DIR("A")="Do you want to print a Patient Med Sheet"
+2 SET DIR("B")="N"
+3 SET DIR(0)="Y"
+4 SET DIR("?")="Please enter Y OR N to print Patient Medication Sheet Also"
+5 DO ^DIR
+6 IF $DATA(DIRUT)
QUIT
+7 IF Y=0
KILL DIR
QUIT
+8 KILL DIR
+9 ;
+10 SET APSQSTOP=0
+11 ; need DFN set and PPL
+12 SET PPL=$GET(PSORX("PSOL",1))
+13 DO EN^APSEPPIM
+14 QUIT
+15 ;
+16 ; Prompt for a date range.
+17 ; .APSPB Start date in FM format (returned)
+18 ; .APSPE End date in FM format (returned)
+19 ; .APSPPOP Abort flag (returned)
+20 ; APSPBDF Default begin date (optional)
+21 ; APSPEDF Default end date (optional)
+22 ; APSPSAME If nonzero, default end date is begin date (optional)
+23 ; APSPTIME If nonzero, ask for time (optional)
+24 ;
ASKDATES(APSPB,APSPE,APSPPOP,APSPBDF,APSPEDF,APSPSAME,APSPTIME) ; EP
+1 NEW APSPOPT
+2 WRITE !!," *** Date Range Selection ***"
+3 SET APSPPOP=0
SET APSPOPT=$SELECT($GET(APSPTIME):"T",1:"")
+4 SET APSPB=$$ASKDATE(" Begin with DATE: ",.APSPBDF,,APSPOPT)
+5 IF 'APSPPOP
SET APSPE=$$ASKDATE(" End with DATE: ",$SELECT($GET(APSPSAME):APSPB,$GET(APSPEDF):APSPEDF,1:""),APSPB,APSPOPT)
+6 QUIT
+7 ; Prompt for single date date
+8 ; APSPPMT = Prompt
+9 ; APSPDFL = Default value (optional)
+10 ; APSPMIN = Minimum value (optional)
+11 ; APSPOPT = Additional options (optional)
ASKDATE(APSPPMT,APSPDFL,APSPMIN,APSPOPT) ;
+1 NEW %DT,Y
+2 SET %DT="APEX"_$GET(APSPOPT)
+3 SET %DT("A")=APSPPMT
+4 IF $GET(APSPMIN)
SET %DT(0)=APSPMIN
+5 IF $GET(APSPDFL)
Begin DoDot:1
+6 SET Y=APSPDFL
+7 DO DD^%DT
+8 SET %DT("B")=Y
End DoDot:1
+9 DO ^%DT
+10 IF Y<0
SET APSPPOP=1
+11 QUIT Y
+12 ;
+13 ; DIR call for required Y/N response
DIRYNR(APSPPMT,APSPDFL,APSPHLP,APSPPOP) ; EP
+1 NEW Y
+2 SET Y=$$DIR("Y",.APSPPMT,.APSPDFL,.APSPHLP,.APSPPOP)
+3 QUIT Y
+4 ; DIR call for Y/N response
DIRYN(APSPPMT,APSPDFL,APSPHLP,APSPPOP) ; EP
+1 NEW Y
+2 SET Y=$$DIR("YO",.APSPPMT,.APSPDFL,.APSPHLP,.APSPPOP)
+3 QUIT Y
+4 ; Paramerized DIR call
DIR(APSPDTP,APSPPMT,APSPDFL,APSPHLP,APSPPOP,APSPSCN) ; EP
+1 NEW DIR,DTOUT,DUOUT,Y
+2 SET DIR(0)=APSPDTP
SET DIR("B")=$GET(APSPDFL)
+3 IF '$GET(APSPPMT)
MERGE DIR("A")=APSPPMT
+4 IF '$TEST
DO GETTEXT(APSPPMT,$NAME(DIR("A")))
+5 IF '$GET(APSPHLP)
MERGE DIR("?")=APSPHLP
+6 IF '$TEST
DO GETTEXT(APSPHLP,$NAME(DIR("?")))
+7 IF $LENGTH($GET(APSPSCN))
SET DIR("S")=APSPSCN
+8 DO ^DIR
+9 IF $DATA(DUOUT)!$DATA(DTOUT)
SET APSPPOP=1
+10 QUIT Y
+11 ; Pause for user input
DIRZ(APSPPMT) ; EP
+1 DO DIR("E",.APSPPMT,,,.APSPPOP)
+2 QUIT
+3 ; Load dialog text into array
+4 ; APSPDG = Dialog index^optional parameters
+5 ; APSPAR = Array to receive text
GETTEXT(APSPDG,APSPAR) ;
+1 NEW APSPPM
+2 KILL @APSPAR
+3 FOR X=2:1:$LENGTH(APSPDG,U)
SET APSPPM(X-1)=$PIECE(APSPDG,U,X)
+4 SET APSPDG=$SELECT(APSPDG<0:-APSPDG,1:+APSPDG)
+5 DO BLD^DIALOG(APSPDG/1000+59000,.APSPPM,,APSPAR)
+6 QUIT
+7 ;
+8 ; Prompt for entry from file
+9 ; APSPFILE = File #
+10 ; APSPPMPT = Prompt
+11 ; APSPPOP = Abort Flag (returned)
+12 ; APSPDIC0 = Additional DIC(0) parameters
GETIEN(APSPFILE,APSPPMPT,APSPPOP,APSPDIC0) ; EP
+1 NEW DIC,APSPD,Y
+2 SET APSPPOP=0
+3 SET APSPD=$$GET1^DIQ(APSPFILE,$$FIND1^DIC(APSPFILE,,," "),.01)
+4 SET DIC=APSPFILE
SET DIC(0)="AE"_$GET(APSPDIC0)
SET DIC("A")=$GET(APSPPMPT)
SET DIC("B")=APSPD
+5 DO ^DIC
+6 IF Y'>0
SET APSPPOP=1
+7 QUIT +Y
+8 ; Prompt for entry from file
+9 ; APSPFILE = File #
+10 ; APSPPMPT = Prompt
+11 ; APSPDFLD = Field whose value is to be used for default value
+12 ; Set to -1 for no default value
+13 ; D - x-ref (C^D)
+14 ; APSPSCRN = DIC("S") SCREEN LOGIC
+15 ; APSPDFLT = Default value set in DIC("B") - not used if APSPDFLD is >0
GETIEN1(APSPFILE,APSPPMPT,APSPDFLD,D,APSPSCRN,APSPDFLT) ; EP
+1 NEW DIC,APSPD,Y
+2 SET D=$GET(D,"B")
+3 IF '$LENGTH(D)
SET D="B"
+4 SET APSPDFLD=$GET(APSPDFLD,.01)
+5 SET APSPD=""
+6 SET DIC("S")=$GET(APSPSCRN)
+7 IF APSPDFLD>0
SET APSPD=$$GET1^DIQ(APSPFILE,$$FIND1^DIC(APSPFILE,,," ",.D,DIC("S")),APSPDFLD)
+8 IF APSPDFLD<0
IF $LENGTH($GET(APSPDFLT))
SET APSPD=APSPDFLT
+9 SET DIC=APSPFILE
SET DIC(0)="AE"
SET DIC("A")=$GET(APSPPMPT)
SET DIC("B")=APSPD
+10 IF $LENGTH(D,U)>1
IF DIC(0)'["M"
SET DIC(0)=DIC(0)_"M"
+11 DO MIX^DIC1
+12 IF Y'>0
SET APSPPOP=1
SET $PIECE(APSPPOP,U,2)=X="@"
+13 QUIT +Y
+14 ; Display required header for menus
TITLE(PKG,VER) ;EP
+1 IF $EXTRACT($GET(IOST),1,2)'="C-"
QUIT
+2 NEW X,%ZIS,IORVON,IORVOFF,MNU
+3 SET MNU=$PIECE(XQY0,U,2)
SET VER="Version "_$GET(VER,1.1)
SET PKG=$GET(PKG,"RPMS-EHR Management")
+4 SET X="IORVON;IORVOFF"
+5 DO ENDR^%ZISS
+6 USE IO
+7 WRITE @IOF,IORVON,$$GET1^DIQ(4,DUZ(2),.01),?(IOM-$LENGTH(PKG)\2),PKG,?(IOM-$LENGTH(VER)),VER,!,IORVOFF,?(IOM-$LENGTH(MNU)\2-$X),MNU
+8 QUIT
+9 ; Edit a parameter from a menu option
EDITPAR(PARAM) ;EP
+1 SET PARAM=$GET(PARAM,$PIECE(XQY0,U))
+2 DO TITLE()
IF $$CHECK(8989.51,PARAM,"Parameter")
DO EDITPAR^XPAREDIT(PARAM)
+3 QUIT
+4 ; Check to make sure entry exists
CHECK(FIL,VAL,ENT) ;
+1 IF $$FIND1^DIC(FIL,,"X",VAL)
QUIT 1
+2 WRITE !,ENT," ",VAL," was not found.",!
+3 DO DIRZ
+4 QUIT 0
