| 1 | PPPUTL1 ;ALB/JFP - UTILITIES (GENERIC);01MAR93
|
|---|
| 2 | ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | CENTER(LINE,CTR) ; -- Centers text on 80 column screen
|
|---|
| 5 | ; INPUT : line - line to center in
|
|---|
| 6 | ; : ctr - text to center
|
|---|
| 7 | ; OUTPUT : X - centered text
|
|---|
| 8 | Q:('$D(LINE)) ""
|
|---|
| 9 | Q:('$D(CTR)) ""
|
|---|
| 10 | N LEN,LNST
|
|---|
| 11 | S LEN=$L(CTR)
|
|---|
| 12 | S LNST=((80-LEN)\2)+1
|
|---|
| 13 | S X=$$INSERT^PPPUTL1(CTR,LINE,LNST,LEN)
|
|---|
| 14 | Q X
|
|---|
| 15 | ;
|
|---|
| 16 | INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;INSERT A STRING INTO ANOTHER
|
|---|
| 17 | ;INPUT : INSTR - String to insert
|
|---|
| 18 | ; OUTSTR - String to insert into
|
|---|
| 19 | ; COLUMN - Where to begin insertion (defaults to end of OUTSTR)
|
|---|
| 20 | ; LENGTH - Number of characters to clear from OUTSTR
|
|---|
| 21 | ; (defaults to length of INSTR)
|
|---|
| 22 | ;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
|
|---|
| 23 | ; using LENGTH characters
|
|---|
| 24 | ; "" - Error (bad input)
|
|---|
| 25 | ;
|
|---|
| 26 | ;NOTE : This module is based on $$SETSTR^VALM1
|
|---|
| 27 | ;
|
|---|
| 28 | ;CHECK INPUT
|
|---|
| 29 | Q:('$D(INSTR)) ""
|
|---|
| 30 | Q:('$D(OUTSTR)) ""
|
|---|
| 31 | S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
|
|---|
| 32 | S:('$D(LENGTH)) LENGTH=$L(INSTR)
|
|---|
| 33 | ;DECLARE VARIABLES
|
|---|
| 34 | N FRONT,END
|
|---|
| 35 | S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
|
|---|
| 36 | S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
|
|---|
| 37 | ;INSERT STRING
|
|---|
| 38 | Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
|
|---|
| 39 | ;
|
|---|
| 40 | ONENTRY(USENTRY) ;SCREEN TO ONLY ALLOW ONE ENTRY IN STATISTIC FILE
|
|---|
| 41 | ;INPUT : USENTRY - What user has entered by user
|
|---|
| 42 | ;OUTPUT : 1 - Entered may be used
|
|---|
| 43 | ; (there is no entry or it is the existing entry)
|
|---|
| 44 | ; 0 - Entered may not be used
|
|---|
| 45 | ; (it is not the existing entry)
|
|---|
| 46 | ;NOTES : Used in screening of field .01
|
|---|
| 47 | ;
|
|---|
| 48 | ;CHECK INPUT
|
|---|
| 49 | Q:('USENTRY) 0
|
|---|
| 50 | ;DECLARE VARIABLES
|
|---|
| 51 | N IFN,CURENTRY
|
|---|
| 52 | ;CURRENTLY NO ENTRY
|
|---|
| 53 | S IFN=$O(^PPP(1020.3,0))
|
|---|
| 54 | Q:('IFN) 1
|
|---|
| 55 | ;CURRENT ENTRY IS ENTERED INSTITUTION
|
|---|
| 56 | S CURENTRY=+$G(^PPP(1020.3,IFN,0))
|
|---|
| 57 | Q:(USENTRY=CURENTRY) 1
|
|---|
| 58 | ;DON'T ALLOW SELECTION
|
|---|
| 59 | Q 0
|
|---|
| 60 | ;
|
|---|
| 61 | DTE(IDTE,STYLE) ; -- Returns formatted date
|
|---|
| 62 | ; INPUT : IDTE - INTERNAL FILEMAN DATE
|
|---|
| 63 | ; STYLE - FLAG INDICATING OUTPUT STYLE
|
|---|
| 64 | ; IF 0, OUTPUT IN MM-DD-YYYY FORMAT (DEFAULT)
|
|---|
| 65 | ; IF 1, OUTPUT IN MMM DD, YYYY FORMAT
|
|---|
| 66 | ; (MMM -> FIRST 3 CHARACTERS OF MONTH NAME)
|
|---|
| 67 | ; OUTPUT : EXTERNAL DATE IN SPECIFIED FORMAT
|
|---|
| 68 | S STYLE=+$G(STYLE)
|
|---|
| 69 | Q:($G(IDTE)="") ""
|
|---|
| 70 | ;MM-DD-YYYY
|
|---|
| 71 | Q:('STYLE) $E(IDTE,4,5)_"-"_$E(IDTE,6,7)_"-"_($E(IDTE,1,3)+1700)
|
|---|
| 72 | ;MMM DD, YYYY
|
|---|
| 73 | N Y,%DT
|
|---|
| 74 | S Y=$P(IDTE,".",1)
|
|---|
| 75 | D DD^%DT
|
|---|
| 76 | Q Y
|
|---|
| 77 | ;
|
|---|
| 78 | END ; -- End of code
|
|---|
| 79 | QUIT
|
|---|
