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

PSJORMA1.m

Go to the documentation of this file. 
  1. PSJORMA1 ;BIR/MV-COLLECT MAR DATA FOR U/D AND INPATIENT MED PENDINGS. ; 10 Mar 98 / 8:50 AM
  1.  ;;5.0; INPATIENT MEDICATIONS ;**2**;16 DEC 97
  1. BLANK(LEN) ;
  1.  NEW X
  1.  S $P(X," ",LEN)=" "
  1.  Q $G(X)
  1.  ;
  1. TXT(TXT,LEN)   ;
  1.  ;* Input: TXT = TXT string
  1.  ;*        LEN = format length
  1.  ;* Output: MARX array.
  1.  ;*
  1.  NEW OLD D SPLIT
  1.  S X=0,X1=1,Y="" F  S X=$O(OLD(X)) Q:'X  D
  1.  . I $L(Y_OLD(X))>LEN S MARX(X1)=Y,X1=X1+1,Y=""
  1.  . S Y=Y_OLD(X)
  1.  S:Y]"" MARX(X1)=Y
  1.  S MARX=X1
  1.  Q
  1.  ;
  1. SPLIT ;* Split a word string into individual words.
  1.  ;* Output: OLD(X)
  1.  ;*
  1.  NEW BSD,NEW,X,X1,Y
  1.  S OLD(1)=TXT Q:$L(TXT)<LEN
  1.  F BSD=" ","/","-" S:'$O(OLD(0)) OLD(1)=TXT D:TXT[BSD DELIM(BSD)
  1.  I '$O(OLD(1)),($L(TXT)>LEN) D LEN(1,TXT) K OLD D
  1.  . F X=0:0 S X=$O(NEW(X)) Q:'X  S OLD(X)=NEW(X)
  1.  Q
  1. LEN(X1,OLD) ;* Wrap word around if it doesn't fit the display lenght.
  1.  NEW X
  1.  Q:$L(OLD)'>LEN
  1.  S X=$E(OLD,1,($L(OLD)-1)) I X["/"!(X["-") Q
  1.  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))
  1.  Q
  1. DELIM(BSD) ;* BSD=" ","/","-"
  1.  K NEW
  1.  S X=0,X1=0 F  S X=$O(OLD(X)) Q:'X  F Y=1:1:$L(OLD(X),BSD) D
  1.  . S X1=X1+1
  1.  . S NEW(X1)=$P(OLD(X),BSD,Y)
  1.  . I $L(OLD(X),BSD)>1,(Y<$L(OLD(X),BSD)) S NEW(X1)=NEW(X1)_BSD
  1.  . D LEN(.X1,NEW(X1))
  1.  K OLD F X=0:0 S X=$O(NEW(X)) Q:'X  S OLD(X)=NEW(X)
  1.  Q
  1.  ;
  1. MARLB(LEN)         ;
  1.  ;;;LEN=LENGHT
  1.  NEW L,X,TXT K MARLB,DRUGNAME
  1.  S L=1
  1.  ;I ON["P",(PSGLRN["___") S MARLB(L)=PSGLOD_" | P E N D I N G"
  1.  I ON["P",+NODE(4) S MARLB(L)=PSGLOD_" | P E N D I N G"
  1.  E  S MARLB(L)=PSGLOD_" |"_PSGLSD_" |"_PSGLFD
  1.  S MARLB(L)=$$SETSTR^VALM1("("_PSGLBS5_")",MARLB(L),36,7)
  1.  S L=L+1
  1.  D DRGDISP^PSJLMUT1(DFN,PSGORD,LEN,39,.DRUGNAME,0)
  1.  F X=0:0 S X=$O(DRUGNAME(X)) Q:'X  S MARLB(L)=DRUGNAME(X)_$S(X=1:$$BLANK(41-$L(DRUGNAME(X)))_PSGLST,1:""),L=L+1
  1.  D TXT^PSGMUTL(PSGLSI,LEN)
  1.  S X=0 F  S X=$O(MARX(X)) Q:'X  S MARLB(L)=MARX(X),L=L+1
  1.  K MARX
  1.  S X=$E("WS",1,PSGLWS*2)_$S(PSGLSM:$E("HSM",PSGLSM,3),1:"")_$E("NF",1,PSGLNF*2)
  1.  I TS<L,(X=""),($L(MARLB(L-1))<24),(L=6) S L=L-1 D
  1.  . S X=MARLB(L)_$$BLANK(23-$L(MARLB(L)))_"RPH: "_$S(PSGLRPH]""&(PSGLRPH'="0"):PSGLRPH,1:"_____")
  1.  . S X=X_$$BLANK(33-$L(X))_"RN: "_$S(PSGLRN]""&(PSGLRN'="0"):PSGLRN,1:"_____")
  1.  . S MARLB(L)=X
  1.  E  D
  1.  . I L#5>0 F L=L:1:5 S MARLB(L)=""
  1.  .; S:L=4 MARLB(4)="",L=5
  1.  . S X=$E("WS",1,PSGLWS*2)
  1.  . S X=X_$$BLANK(4-$L(X))_$S(PSGLSM:$E("HSM",PSGLSM,3),1:"")
  1.  . S X=X_$$BLANK(8-$L(X))_$E("NF",1,PSGLNF*2)
  1.  . S X=X_$$BLANK(23-$L(X))_"RPH: "_$S(PSGLRPH]""&(PSGLRPH'="0"):PSGLRPH,1:"____")
  1.  . S X=X_$$BLANK(33-$L(X))_"RN: "_$S(PSGLRN]""&(PSGLRN'="0"):PSGLRN,1:"_____")
  1.  . S MARLB(L)=X
  1.  S MARLB=L
  1.  I MARLB>5!($G(TS)>5) D MARLB2
  1.  Q
  1.  ;
  1. MARLB2 ;Slit array into 2 labels.
  1.  ;TS array must be defined. (TS^PSGMAR3(ADMIN TIMES))
  1.  NEW INIT,X,Y
  1.  S INIT=MARLB(MARLB),Y=5
  1.  F X=5:1:MARLB S X(X)=MARLB(X)
  1.  F X=5:1:($S(MARLB>TS:MARLB,1:TS)-1) D
  1.  . I (X#5)=0 S MARLB(X)="See next label for continuation" Q
  1.  . I Y<(MARLB) S MARLB(X)=X(Y),Y=Y+1 Q
  1.  . S MARLB(X)=""
  1.  S X=X+1 F Y=Y:1:MARLB-1 S MARLB(X)=$G(X(Y)),X=X+1
  1.  F X=X:0 Q:(X#5)=0  S MARLB(X)="",X=X+1
  1.  S MARLB(X)=INIT,MARLB=X
  1.  Q
  1.  N X F X=5:1:MARLB S X(X+1)=MARLB(X)
  1.  S MARLB(5)="See next label for continuation"
  1.  F X=7:1:MARLB S MARLB(X)=X(X)
  1.  F X=X+1:1:11 S MARLB(X)=""
  1.  S MARLB(10)=X(MARLB+1)
  1.  S MARLB=10
  1.  Q
  1.  ;