| [613] | 1 | PSGMUTL ;BIR/MV-UTLILITY USE FOR THE MAR AND MEDWS. ;15 SEP 97 / 2:10 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**50,104,110,111,131**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA 2191.
|
|---|
| 5 | ;
|
|---|
| 6 | MARFORM ;Prompt for the MAR form (Blank and Non-blank)
|
|---|
| 7 | S DIR(0)="SA^1:Print Blank MARs only;2:Print Non-Blank MARs only;3:Print both Blank and Non-Blank MARs"
|
|---|
| 8 | S DIR("A")="Select the MAR forms: ",DIR("B")="3"
|
|---|
| 9 | S DIR("?")=""
|
|---|
| 10 | S DIR("?",1)="Enter 1 to print BLANK (no data) MARs for the patient(s) you select."
|
|---|
| 11 | S DIR("?",2)="Enter 2 to print MARs complete with orders."
|
|---|
| 12 | S DIR("?",3)="Enter 3 to print both the blank MARs and the MARs complete with orders."
|
|---|
| 13 | S DIR("?",4)="Enter an '^' to exit this option now."
|
|---|
| 14 | D ^DIR S PSGMARB=$S($D(DIRUT):0,1:Y)
|
|---|
| 15 | Q
|
|---|
| 16 | BLANK(LEN) ;
|
|---|
| 17 | NEW X
|
|---|
| 18 | S $P(X," ",LEN)=" "
|
|---|
| 19 | Q $G(X)
|
|---|
| 20 | ;
|
|---|
| 21 | TXT(TXT,LEN) ;
|
|---|
| 22 | ;* Input: TXT = TXT string
|
|---|
| 23 | ;* LEN = format length
|
|---|
| 24 | ;* Output: MARX array.
|
|---|
| 25 | ;*
|
|---|
| 26 | NEW OLD,X1,Y D SPLIT K MARX
|
|---|
| 27 | S X=0,X1=1,Y="" F S X=$O(OLD(X)) Q:'X D
|
|---|
| 28 | . I $L(Y_OLD(X))>LEN S MARX(X1)=Y,X1=X1+1,Y="" D
|
|---|
| 29 | .. I $E(MARX(X1-1),$L(MARX(X1-1)))'=" " Q
|
|---|
| 30 | .. S MARX(X1-1)=$E(MARX(X1-1),1,$L(MARX(X1-1))-1)
|
|---|
| 31 | . S Y=Y_OLD(X)
|
|---|
| 32 | S:Y]"" MARX(X1)=Y
|
|---|
| 33 | S MARX=X1
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | SPLIT ;* Split a word string into individual words.
|
|---|
| 37 | ;* Output: OLD(X)
|
|---|
| 38 | ;*
|
|---|
| 39 | NEW BSD,NEW,X,X1,Y
|
|---|
| 40 | S OLD(1)=TXT Q:$L(TXT)<LEN
|
|---|
| 41 | F BSD=" ","/","-" S:'$O(OLD(0)) OLD(1)=TXT D:TXT[BSD DELIM(BSD)
|
|---|
| 42 | I '$O(OLD(1)),($L(TXT)>LEN) D LEN(1,TXT) K OLD D
|
|---|
| 43 | . F X=0:0 S X=$O(NEW(X)) Q:'X S OLD(X)=NEW(X)
|
|---|
| 44 | Q
|
|---|
| 45 | LEN(X1,OLD) ;* Wrap word around if it doesn't fit the display length
|
|---|
| 46 | NEW X
|
|---|
| 47 | Q:$L(OLD)'>LEN
|
|---|
| 48 | S X=$E(OLD,1,($L(OLD)-1)) I X["/"!((X["-")&(X'["ON-CALL")) Q
|
|---|
| 49 | I $L(OLD)>LEN F X=1:1 S NEW(X1)=$E(OLD,((LEN*X)-LEN+1),(LEN*X)),X1=X1+1 Q:($L(OLD)'>(LEN*X))
|
|---|
| 50 | Q
|
|---|
| 51 | DELIM(BSD) ;* BSD=" ","/","-"
|
|---|
| 52 | K NEW
|
|---|
| 53 | S X=0,X1=0 F S X=$O(OLD(X)) Q:'X K ONCALL F Y=1:1:$L(OLD(X),BSD) D
|
|---|
| 54 | . Q:($G(ONCALL)=Y) ; If ON-CALL is delimited string, ignore
|
|---|
| 55 | . S X1=X1+1
|
|---|
| 56 | . S NEW(X1)=$P(OLD(X),BSD,Y)
|
|---|
| 57 | . I $L(OLD(X),BSD)>1,(Y<$L(OLD(X),BSD)) S NEW(X1)=NEW(X1)_BSD
|
|---|
| 58 | . I BSD="-",OLD(X)["ON-CALL" D ;If dashes, check for ON-CALL
|
|---|
| 59 | .. S NEW(X1)=OLD(X),ONCALL=Y+1 ;Keep ON-CALL intact
|
|---|
| 60 | . D LEN(.X1,NEW(X1))
|
|---|
| 61 | K OLD F X=0:0 S X=$O(NEW(X)) Q:'X S OLD(X)=NEW(X)
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | MARLB(LEN) ;
|
|---|
| 65 | ;;;LEN=LENGTH
|
|---|
| 66 | NEW L,X,TXT K MARLB,DRUGNAME,ON S ON=PSGORD D ONHOLD^PSGMMAR2
|
|---|
| 67 | S L=1
|
|---|
| 68 | S MARLB(L)=$$BLANK(6)_"|"_$$BLANK(12)_"|",L=L+1
|
|---|
| 69 | I $G(PST)["CZ"!($G(PST)["OZ") S MARLB(L)=PSGLOD_" | P E N D I N G"
|
|---|
| 70 | E S MARLB(L)=PSGLOD_" |"_PSGLSD_" |"_PSGLFD
|
|---|
| 71 | I $G(ONHOLD) S MARLB(L)=PSGLOD_" | O N H O L D "
|
|---|
| 72 | S MARLB(L)=$$SETSTR^VALM1("("_$E(PPN)_$E(PSSN,8,12)_")",MARLB(L),40,7)
|
|---|
| 73 | S L=L+1
|
|---|
| 74 | D DRGDISP^PSJLMUT1(PSGP,+PSGORD_$S(PSGORD["P":"P",1:"U"),45,39,.DRUGNAME,0)
|
|---|
| 75 | F X=0:0 S X=$O(DRUGNAME(X)) Q:'X S MARLB(L)=DRUGNAME(X)_$S(X=1:$$BLANK(47-$L(DRUGNAME(X)))_PSGLST,1:""),L=L+1
|
|---|
| 76 | D TXT^PSGMUTL(PSGLSI,LEN)
|
|---|
| 77 | S X=0 F S X=$O(MARX(X)) Q:'X S MARLB(L)=MARX(X),L=L+1
|
|---|
| 78 | K MARX
|
|---|
| 79 | I $G(PSGP),$G(PSGORD),(PSGLRN]""),(PSGLRN'="O") D
|
|---|
| 80 | .N ND4 S ND4=$S(PSGORD["U":$G(^PS(55,PSGP,5,+PSGORD,4)),PSGORD["P":$G(^PS(53.1,+PSGORD,4)),1:"")
|
|---|
| 81 | .N PSGLREN,PSGLRNDT S PSGLREN=+$$LASTREN^PSJLMPRI(PSGP,PSGORD),PSGLRNDT=$P(ND4,"^",2) I PSGLREN,PSGLRNDT I PSGLREN>PSGLRNDT S PSGLRN=""
|
|---|
| 82 | S X=$E("WS",1,PSGLWS*2)_$S(PSGLSM:$E("HSM",PSGLSM,3),1:"")_$E("NF",1,PSGLNF*2)
|
|---|
| 83 | I X="",($L(MARLB(L-1))<30),(L=7) S L=L-1 D
|
|---|
| 84 | . S X=MARLB(L)_$$BLANK(29-$L(MARLB(L)))_"RPH: "_$S(PSGLRPH]""&(PSGLRPH'="0"):PSGLRPH,1:"_____")
|
|---|
| 85 | . S X=X_$$BLANK(39-$L(X))_"RN: "_$S(PSGLRN]""&(PSGLRN'="0"):PSGLRN,1:"_____")
|
|---|
| 86 | . S MARLB(L)=X
|
|---|
| 87 | E D
|
|---|
| 88 | . S:L=5 MARLB(5)="",L=6
|
|---|
| 89 | . S X=$E("WS",1,PSGLWS*2)
|
|---|
| 90 | . S X=X_$$BLANK(4-$L(X))_$S(PSGLSM:$E("HSM",PSGLSM,3),1:"")
|
|---|
| 91 | . S X=X_$$BLANK(8-$L(X))_$E("NF",1,PSGLNF*2)
|
|---|
| 92 | . S X=X_$$BLANK(29-$L(X))_"RPH: "_$S(PSGLRPH]""&(PSGLRPH'="0"):PSGLRPH,1:"____")
|
|---|
| 93 | . S X=X_$$BLANK(39-$L(X))_"RN: "_$S(PSGLRN]""&(PSGLRN'="0"):PSGLRN,1:"_____")
|
|---|
| 94 | . S MARLB(L)=X
|
|---|
| 95 | S MARLB=L
|
|---|
| 96 | I MARLB>6!($G(TS)>6) D MARLB2
|
|---|
| 97 | Q
|
|---|
| 98 | ;
|
|---|
| 99 | MARLB2 ;Split array into 2 labels.
|
|---|
| 100 | ;TS array must be defined. (TS^PSGMAR3(ADMIN TIMES))
|
|---|
| 101 | NEW INIT,X,Y
|
|---|
| 102 | S INIT=MARLB(MARLB),Y=6
|
|---|
| 103 | F X=6:1:MARLB S X(X)=MARLB(X)
|
|---|
| 104 | F X=6:1:($S(MARLB>TS:MARLB,1:TS)-1) D
|
|---|
| 105 | . I (X#6)=0 S MARLB(X)="See next label for continuation" Q
|
|---|
| 106 | . I Y<(MARLB) S MARLB(X)=X(Y),Y=Y+1 Q
|
|---|
| 107 | . S MARLB(X)=""
|
|---|
| 108 | S X=X+1 F Y=Y:1:MARLB-1 S MARLB(X)=$G(X(Y)),X=X+1
|
|---|
| 109 | F X=X:0 Q:(X#6)=0 S MARLB(X)="",X=X+1
|
|---|
| 110 | S MARLB(X)=INIT,MARLB=X
|
|---|
| 111 | Q
|
|---|
| 112 | N X F X=6:1:MARLB S X(X+1)=MARLB(X)
|
|---|
| 113 | S MARLB(6)="See next label for continuation"
|
|---|
| 114 | F X=7:1:MARLB S MARLB(X)=X(X)
|
|---|
| 115 | F X=X+1:1:11 S MARLB(X)=""
|
|---|
| 116 | S MARLB(12)=X(MARLB+1)
|
|---|
| 117 | S MARLB=12
|
|---|
| 118 | Q
|
|---|
| 119 | ;
|
|---|
