- 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