| [613] | 1 | PSGMI ;BIR/CML3-MISCELLANEOUS INFORMATION ; 23 Apr 98 / 12:55 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**8**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ENPDN(X) ; orderable item name
|
|---|
| 5 | ; X - pointer to Orderable Item (50.7) file
|
|---|
| 6 | N Y I $G(X)="" Q "NOT FOUND"
|
|---|
| 7 | I X S Y=$P($G(^PS(50.7,X,0)),"^") S:Y="" Y=X_";PS(50.7," Q Y
|
|---|
| 8 | Q X
|
|---|
| 9 | ;
|
|---|
| 10 | ENDDN(X) ; dispense drug name
|
|---|
| 11 | ; X - pointer to Drug (50) file
|
|---|
| 12 | N Y I $G(X)="" Q "NOT FOUND"
|
|---|
| 13 | I X S Y=$P($G(^PSDRUG(X,0)),"^") S:Y="" Y=X_";PSDRUG(" Q Y
|
|---|
| 14 | Q X
|
|---|
| 15 | ;
|
|---|
| 16 | ENMRN(X) ; med route name
|
|---|
| 17 | ; X - pointer to Medication Route (51.2) file
|
|---|
| 18 | N Y I $G(X)="" Q "NOT FOUND"
|
|---|
| 19 | I X S Y=$G(^PS(51.2,X,0)),Y=$S($P(Y,"^",3)]"":$P(Y,"^",3),1:$P(Y,"^")) S:Y="" Y=X_";PS(51.2," Q Y
|
|---|
| 20 | Q X
|
|---|
| 21 | ;
|
|---|
| 22 | ENMRA(X) ; Med Route Abbrev.
|
|---|
| 23 | Q $P($G(^PS(51.2,X,0)),U,3)
|
|---|
| 24 | ;
|
|---|
| 25 | ENNPN(X) ; new person name
|
|---|
| 26 | ; X - pointer to New Person (200) file
|
|---|
| 27 | N Y I $G(X)="" Q "NOT FOUND"
|
|---|
| 28 | I X S Y=$P($G(^VA(200,X,0)),"^") S:Y="" Y=X_";VA(200," Q Y
|
|---|
| 29 | Q X
|
|---|
| 30 | ;
|
|---|
| 31 | ENSTN(X) ; schedule type name
|
|---|
| 32 | ; X - Schedule Type code
|
|---|
| 33 | S X=$S($G(X)="":"NOT FOUND",X="C":"CONTINUOUS",X="O":"ONE TIME",X="OC":"ON CALL",X="P":"PRN",X="R":"FILL on REQUEST",1:X)
|
|---|
| 34 | Q X
|
|---|
| 35 | ;
|
|---|
| 36 | ENDTC(Y) ; FM internal date/time to user readable, Inpatient style
|
|---|
| 37 | ; Y - date in FileMan internal format
|
|---|
| 38 | I $G(Y) S Y=Y_$E(".",Y'[".")_"0000" Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
|
|---|
| 39 | Q "********"
|
|---|
| 40 | ;
|
|---|
| 41 | ENDTC1(Y) ; FM internal date/time to user readable, only 1 space before time.
|
|---|
| 42 | ; Y - date in FileMan internal format
|
|---|
| 43 | I $G(Y) S Y=Y_$E(".",Y'[".")_"0000" Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
|
|---|
| 44 | Q "********"
|
|---|
| 45 | ENDD(Y) ; FM internal date/time to user readable - stolen from ^DD("DD")
|
|---|
| 46 | ; Y - date in FileMan internal format
|
|---|
| 47 | S:$G(Y) Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12)_$S($E(Y,13,14):":"_$E(Y_0,13,14),1:""),"^",Y[".")
|
|---|
| 48 | Q Y
|
|---|
| 49 | ;
|
|---|
| 50 | ENPDS(Y,CODES) ; look-up screen for Orderable Items
|
|---|
| 51 | ; CODES - set of codes separated by commas
|
|---|
| 52 | ; Y - pointer to the Orderable Item (50.7) file
|
|---|
| 53 | N ND,X,Z I 0
|
|---|
| 54 | S ND=$G(^PS(50.7,+Y,0))
|
|---|
| 55 | Q $S($P(ND,U,4)>DT:1,1:0)
|
|---|
| 56 | F Z=1:1:$L(CODES,",") S X=$P(CODES,",",Z) Q:X="" I $D(^PS(50.3,Y,1,"AFI",X))'[0 S ND=$G(^(X)) I $S('$P(ND,"^",2):1,1:$P(ND,"^",2)>DT) Q
|
|---|
| 57 | Q $T
|
|---|
| 58 | ;
|
|---|
| 59 | ENLU(X) ; convert lower case to upper case
|
|---|
| 60 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 61 | ;
|
|---|
| 62 | ENUL(X) ; convert upper case to lower case
|
|---|
| 63 | Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
|
|---|
| 64 | ENDTC2(Y) ; FM internal date/time to user readable, 4 digit year
|
|---|
| 65 | ; Y - date in FileMan internal format
|
|---|
| 66 | I $G(Y) S Y=Y_$E(".",Y'[".")_"0000" Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
|
|---|
| 67 | Q "********"
|
|---|
