Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APSPUTIL

APSPUTIL.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. PMS ; EP  ; called from PSORXL before go in to print the label  3/1/2002
  1.  S DIR("A")="Do you want to print a Patient Med Sheet"
  1.  S DIR("B")="N"
  1.  S DIR(0)="Y"
  1.  S DIR("?")="Please enter Y OR N to print Patient Medication Sheet Also"
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  I Y=0 K DIR Q
  1.  K DIR
  1.  ;
  1.  S APSQSTOP=0
  1.  ;   need DFN set  and PPL
  1.  S PPL=$G(PSORX("PSOL",1))
  1.  D EN^APSEPPIM
  1.  Q
  1.  ;
  1.  ; Prompt for a date range.
  1.  ; .APSPB    Start date in FM format (returned)
  1.  ; .APSPE    End date in FM format (returned)
  1.  ; .APSPPOP  Abort flag (returned)
  1.  ;  APSPBDF  Default begin date (optional)
  1.  ;  APSPEDF  Default end date (optional)
  1.  ;  APSPSAME If nonzero, default end date is begin date (optional)
  1.  ;  APSPTIME If nonzero, ask for time (optional)
  1.  ;
  1. ASKDATES(APSPB,APSPE,APSPPOP,APSPBDF,APSPEDF,APSPSAME,APSPTIME) ; EP
  1.  N APSPOPT
  1.  W !!,"   *** Date Range Selection ***"
  1.  S APSPPOP=0,APSPOPT=$S($G(APSPTIME):"T",1:"")
  1.  S APSPB=$$ASKDATE("   Begin with DATE: ",.APSPBDF,,APSPOPT)
  1.  S:'APSPPOP APSPE=$$ASKDATE("     End with DATE: ",$S($G(APSPSAME):APSPB,$G(APSPEDF):APSPEDF,1:""),APSPB,APSPOPT)
  1.  Q
  1.  ; Prompt for single date date
  1.  ; APSPPMT = Prompt
  1.  ; APSPDFL = Default value (optional)
  1.  ; APSPMIN = Minimum value (optional)
  1.  ; APSPOPT = Additional options (optional)
  1. ASKDATE(APSPPMT,APSPDFL,APSPMIN,APSPOPT) ;
  1.  N %DT,Y
  1.  S %DT="APEX"_$G(APSPOPT)
  1.  S %DT("A")=APSPPMT
  1.  S:$G(APSPMIN) %DT(0)=APSPMIN
  1.  I $G(APSPDFL) D
  1.  .S Y=APSPDFL
  1.  .D DD^%DT
  1.  .S %DT("B")=Y
  1.  D ^%DT
  1.  S:Y<0 APSPPOP=1
  1.  Q Y
  1.  ;
  1.  ; DIR call for required Y/N response
  1. DIRYNR(APSPPMT,APSPDFL,APSPHLP,APSPPOP) ; EP
  1.  N Y
  1.  S Y=$$DIR("Y",.APSPPMT,.APSPDFL,.APSPHLP,.APSPPOP)
  1.  Q Y
  1.  ; DIR call for Y/N response
  1. DIRYN(APSPPMT,APSPDFL,APSPHLP,APSPPOP) ; EP
  1.  N Y
  1.  S Y=$$DIR("YO",.APSPPMT,.APSPDFL,.APSPHLP,.APSPPOP)
  1.  Q Y
  1.  ; Paramerized DIR call
  1. DIR(APSPDTP,APSPPMT,APSPDFL,APSPHLP,APSPPOP,APSPSCN) ; EP
  1.  N DIR,DTOUT,DUOUT,Y
  1.  S DIR(0)=APSPDTP,DIR("B")=$G(APSPDFL)
  1.  I '$G(APSPPMT) M DIR("A")=APSPPMT
  1.  E  D GETTEXT(APSPPMT,$NA(DIR("A")))
  1.  I '$G(APSPHLP) M DIR("?")=APSPHLP
  1.  E  D GETTEXT(APSPHLP,$NA(DIR("?")))
  1.  S:$L($G(APSPSCN)) DIR("S")=APSPSCN
  1.  D ^DIR
  1.  S:$D(DUOUT)!$D(DTOUT) APSPPOP=1
  1.  Q Y
  1.  ; Pause for user input
  1. DIRZ(APSPPMT) ; EP
  1.  D DIR("E",.APSPPMT,,,.APSPPOP)
  1.  Q
  1.  ; Load dialog text into array
  1.  ; APSPDG = Dialog index^optional parameters
  1.  ; APSPAR = Array to receive text
  1. GETTEXT(APSPDG,APSPAR) ;
  1.  N APSPPM
  1.  K @APSPAR
  1.  F X=2:1:$L(APSPDG,U) S APSPPM(X-1)=$P(APSPDG,U,X)
  1.  S APSPDG=$S(APSPDG<0:-APSPDG,1:+APSPDG)
  1.  D BLD^DIALOG(APSPDG/1000+59000,.APSPPM,,APSPAR)
  1.  Q
  1.  ;
  1.  ; Prompt for entry from file
  1.  ; APSPFILE = File #
  1.  ; APSPPMPT = Prompt
  1.  ; APSPPOP =  Abort Flag (returned)
  1.  ; APSPDIC0 = Additional DIC(0) parameters
  1. GETIEN(APSPFILE,APSPPMPT,APSPPOP,APSPDIC0) ; EP
  1.  N DIC,APSPD,Y
  1.  S APSPPOP=0
  1.  S APSPD=$$GET1^DIQ(APSPFILE,$$FIND1^DIC(APSPFILE,,," "),.01)
  1.  S DIC=APSPFILE,DIC(0)="AE"_$G(APSPDIC0),DIC("A")=$G(APSPPMPT),DIC("B")=APSPD
  1.  D ^DIC
  1.  S:Y'>0 APSPPOP=1
  1.  Q +Y
  1.  ; Prompt for entry from file
  1.  ; APSPFILE = File #
  1.  ; APSPPMPT = Prompt
  1.  ; APSPDFLD = Field whose value is to be used for default value
  1.  ;          Set to -1 for no default value
  1.  ; D - x-ref (C^D)
  1.  ; APSPSCRN = DIC("S") SCREEN LOGIC
  1.  ; APSPDFLT = Default value set in DIC("B") - not used if APSPDFLD is >0
  1. GETIEN1(APSPFILE,APSPPMPT,APSPDFLD,D,APSPSCRN,APSPDFLT) ; EP
  1.  N DIC,APSPD,Y
  1.  S D=$G(D,"B")
  1.  S:'$L(D) D="B"
  1.  S APSPDFLD=$G(APSPDFLD,.01)
  1.  S APSPD=""
  1.  S DIC("S")=$G(APSPSCRN)
  1.  S:APSPDFLD>0 APSPD=$$GET1^DIQ(APSPFILE,$$FIND1^DIC(APSPFILE,,," ",.D,DIC("S")),APSPDFLD)
  1.  I APSPDFLD<0,$L($G(APSPDFLT)) S APSPD=APSPDFLT
  1.  S DIC=APSPFILE,DIC(0)="AE",DIC("A")=$G(APSPPMPT),DIC("B")=APSPD
  1.  I $L(D,U)>1,DIC(0)'["M" S DIC(0)=DIC(0)_"M"
  1.  D MIX^DIC1
  1.  S:Y'>0 APSPPOP=1,$P(APSPPOP,U,2)=X="@"
  1.  Q +Y
  1.  ; Display required header for menus
  1. TITLE(PKG,VER) ;EP
  1.  Q:$E($G(IOST),1,2)'="C-"
  1.  N X,%ZIS,IORVON,IORVOFF,MNU
  1.  S MNU=$P(XQY0,U,2),VER="Version "_$G(VER,1.1),PKG=$G(PKG,"RPMS-EHR Management")
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  U IO
  1.  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
  1.  Q
  1.  ; Edit a parameter from a menu option
  1. EDITPAR(PARAM) ;EP
  1.  S PARAM=$G(PARAM,$P(XQY0,U))
  1.  D TITLE(),EDITPAR^XPAREDIT(PARAM):$$CHECK(8989.51,PARAM,"Parameter")
  1.  Q
  1.  ; Check to make sure entry exists
  1. CHECK(FIL,VAL,ENT) ;
  1.  Q:$$FIND1^DIC(FIL,,"X",VAL) 1
  1.  W !,ENT," ",VAL," was not found.",!
  1.  D DIRZ
  1.  Q 0