GMRGRUT2 ;CISC/RM,RTK-GMRG ROUTINE UTILITIES ;8/23/93
;;3.0;Text Generator;;Jan 24, 1996
EN1 ;TO PRINT/CALCULTE AGGY TEXT FOR A PATIENT (DFN) AND GMR TEXT ENTRY
; (GMRGPDA) INCLUDES THE INTERNAL AND APPENDED TEXT
;INPUT VARIABLES= 1.) GMRGXPRT= AGGY TEXT
; 2.) GMRGXPRT(0)=PT DATA IN APPENDED/INTERNAL FIELD OF
; SECTION SUBFIELD FOR AGGY TERM IN
; GMRGXPRT.
; 3.) GMRGXPRT(1)=RT MART^LENGTH^$S(1 IF INCLUDE
; BRACKETS,O TO NOT INCLUDE BRACKETS)^
; $S(1 TO HIGHLIGHT PRINT, 0 TO NOT)^
; $S(0 TO PRINT THE TEXT OUT WITH THE
; PREVIOUSLY SPECIFIED FORMAT,1 NOT
; TO PRINT OUT THE DATA BUT TO PUT
; IN THE VARIABLE GMRGXPRT)^
; $S(1 TO HIDE TEXT IN <>, 0 NOT HIDE)
; optional variable defaut = 0^IOM^1^0^0
;
;OUTPUT IF $P(GMRGXPRT(1),"^",5)=0 THE AGGY TERM PRINTED OUT AND
; THE VARIABLE GMRGXPRT IS KILLED
; ELSE THE VARIABLE GMRGXPRT IS RETURNED AS THE PRINTABLE TEXT
;ALL VARIABLES KILLED
Q:'$D(GMRGXPRT)!'$D(GMRGXPRT(0)) S:'$D(GMRGXPRT(1)) GMRGXPRT(1)="0^"_IOM_"^1^0"
I $P(GMRGXPRT(1),"^",4),'$D(GMRGIO("RVON"))!'$D(GMRGIO("RVOF")) S X="IORVOFF;IORVON" D ENDR^%ZISS
I $P(GMRGXPRT(1),"^",4) S GMRGXPRT(4)=$S($D(GMRGIO("RVON")):GMRGIO("RVON"),1:IORVON),GMRGXPRT(5)=$S($D(GMRGIO("RVOF")):GMRGIO("RVOF"),1:IORVOFF) K IORVON,IORVOFF
I $P(GMRGXPRT(1),"^",6) D
. S GMRGXPRT(2)=GMRGXPRT
. F GMRGXPRT("X")=0:0 S GMRGXPRT("X")=$F(GMRGXPRT(2),"<",GMRGXPRT("X")) Q:GMRGXPRT("X")'>0 D REMOVE
. S GMRGXPRT=GMRGXPRT(2)
. Q
I GMRGXPRT'["]" S GMRGXPRT(2)=GMRGXPRT
E D BRACK
S GMRGXPRT(2)=GMRGXPRT(2)_$S($P(GMRGXPRT(0),"|")="":"",1:" "_$P(GMRGXPRT(0),"|"))
S GMRGPLN=GMRGXPRT(2) F GMRGXPRT("X")=0:0 Q:$E(GMRGPLN,$L(GMRGPLN))'=" " S GMRGPLN=$E(GMRGPLN,1,$L(GMRGPLN)-1)
G:$P(GMRGXPRT(1),"^",5)=1 Q1 S GMRGLEN=$P(GMRGXPRT(1),"^",2)-$P(GMRGXPRT(1),"^") D FITLINE^GMRGRUT1
W ?($P(GMRGXPRT(1),"^")) D HION W GMRGPLN(0) D HIOF
F GMRGXPRT(3)=1:1 Q:GMRGPLN(1)="" S GMRGPLN=GMRGPLN(1),GMRGLEN=$P(GMRGXPRT(1),"^",2)-$P(GMRGXPRT(1),"^") D FITLINE^GMRGRUT1 W !,?($P(GMRGXPRT(1),"^")) D HION W GMRGPLN(0) D HIOF
Q1 I $P(GMRGXPRT(1),"^",5) K GMRGXPRT S GMRGXPRT=GMRGPLN
E K GMRGXPRT
K GMRGPLN,DX,DY
Q
REMOVE ;
S GMRGXPRT("Y")=$F(GMRGXPRT(2),">",GMRGXPRT("X")) Q:GMRGXPRT("Y")'>0
S GMRGXPRT(2)=$E(GMRGXPRT(2),1,GMRGXPRT("X")-$S($E(GMRGXPRT(2),GMRGXPRT("X")-2)'=" ":2,1:3))_$E(GMRGXPRT(2),GMRGXPRT("Y"),$L(GMRGXPRT(2))),GMRGXPRT("X")=0
Q
BRACK ;
S GMRGXPRT(2)=$P(GMRGXPRT,"[")
F GMRGXPRT(3)=1:1:($L(GMRGXPRT,"]")-1) D SBR
Q
SBR ;
S GMRGXPRT(2)=GMRGXPRT(2)_$S($P(GMRGXPRT(1),"^",3):"[",1:"")_$S($P(GMRGXPRT(0),"|",GMRGXPRT(3)+1)="":$P($P(GMRGXPRT,"[",GMRGXPRT(3)+1),"]"),1:$P(GMRGXPRT(0),"|",GMRGXPRT(3)+1))
S GMRGXPRT(2)=GMRGXPRT(2)_$S($P(GMRGXPRT(1),"^",3):"]",1:"")_$P($P(GMRGXPRT,"]",GMRGXPRT(3)+1),"[")
Q
HION ;
Q:'$P(GMRGXPRT(1),"^",4) S DX=$X W GMRGXPRT(4) I DX'=$X S DY=$Y X ^%ZOSF("XY")
Q
HIOF ;
Q:'$P(GMRGXPRT(1),"^",4) S DX=$X W GMRGXPRT(5) I DX'=$X S DY=$Y X ^%ZOSF("XY")
Q
DEMPAT ; PRINT PATIENTS DEMOGRAPHIC DATA
W !!,GMRGLIN("*"),!
W "NAME: ",$E(GMRGVNAM,1,30),?39,"SSN: ",GMRGVSSN,?58,"DOB: ",GMRGVDOB
I GMRGVAMV>0 W !,"ADMISSION DATE: ",GMRGVADT,?39,"WARD: ",GMRGVWRD
W !,GMRGLIN("*"),!! R "Press return to continue ",X:DTIME I X="^"!(X="^^")!'$T S GMRGOUT=1 Q
Q
PATDAT ; GIVEN GMRGPAT(X) AS "ALIST" ENTRIES FOR A PARTICULAR AGGY TERM
; AND GMRGND=TO AGGY TERM WHICH WE ARE LOOKING FOR IN "ALIST",
; AND GMRGPDA = THE ENTRY IN THE 124.3 FILE IN WHICH WE ARE LOOKING
; THIS FUNCTION RETURNS GMRGPRT=0 (NOT IN ARRAY),1 (IN ARRAY)
; AND GMRGPRT(0)=0TH NODE OF ENTRY IN 124.3, FILE
K GMRGPRT S GMRGPRT=0,GMRGPRT(0)="" F GMRG11=0:0 S GMRG11=$O(GMRGPAT(GMRG11)) Q:GMRG11'>0 I GMRGPAT(GMRG11)[("^"_GMRGND_"^") S GMRGPRT=1 Q
I 'GMRGPRT,$D(^GMR(124.3,GMRGPDA,1,"ALIST",GMRGND)) S GMRG0=GMRGND,GMRGND(0)=GMRGND,GMRGND(1)=$P(GMRGTERM,"^"),GMRGND=GMRGPDA D PARST^GMRGRUT0 S GMRGND=GMRG0,GMRGPRT=1
I GMRGPRT S GMRGND(0)=$O(^GMR(124.3,GMRGPDA,1,"B",GMRGND,0)) I GMRGND(0)>0 S GMRGPRT(0)=GMRGND(0)_"^"_$S($D(^GMR(124.3,GMRGPDA,1,GMRGND(0),0)):$P(^(0),"^",2),1:"")
K GMRGND,GMRG0
Q
GMRGRUT2 ;CISC/RM,RTK-GMRG ROUTINE UTILITIES ;8/23/93
+1 ;;3.0;Text Generator;;Jan 24, 1996
EN1 ;TO PRINT/CALCULTE AGGY TEXT FOR A PATIENT (DFN) AND GMR TEXT ENTRY
+1 ; (GMRGPDA) INCLUDES THE INTERNAL AND APPENDED TEXT
+2 ;INPUT VARIABLES= 1.) GMRGXPRT= AGGY TEXT
+3 ; 2.) GMRGXPRT(0)=PT DATA IN APPENDED/INTERNAL FIELD OF
+4 ; SECTION SUBFIELD FOR AGGY TERM IN
+5 ; GMRGXPRT.
+6 ; 3.) GMRGXPRT(1)=RT MART^LENGTH^$S(1 IF INCLUDE
+7 ; BRACKETS,O TO NOT INCLUDE BRACKETS)^
+8 ; $S(1 TO HIGHLIGHT PRINT, 0 TO NOT)^
+9 ; $S(0 TO PRINT THE TEXT OUT WITH THE
+10 ; PREVIOUSLY SPECIFIED FORMAT,1 NOT
+11 ; TO PRINT OUT THE DATA BUT TO PUT
+12 ; IN THE VARIABLE GMRGXPRT)^
+13 ; $S(1 TO HIDE TEXT IN <>, 0 NOT HIDE)
+14 ; optional variable defaut = 0^IOM^1^0^0
+15 ;
+16 ;OUTPUT IF $P(GMRGXPRT(1),"^",5)=0 THE AGGY TERM PRINTED OUT AND
+17 ; THE VARIABLE GMRGXPRT IS KILLED
+18 ; ELSE THE VARIABLE GMRGXPRT IS RETURNED AS THE PRINTABLE TEXT
+19 ;ALL VARIABLES KILLED
+20 IF '$DATA(GMRGXPRT)!'$DATA(GMRGXPRT(0))
QUIT
IF '$DATA(GMRGXPRT(1))
SET GMRGXPRT(1)="0^"_IOM_"^1^0"
+21 IF $PIECE(GMRGXPRT(1),"^",4)
IF '$DATA(GMRGIO("RVON"))!'$DATA(GMRGIO("RVOF"))
SET X="IORVOFF;IORVON"
DO ENDR^%ZISS
+22 IF $PIECE(GMRGXPRT(1),"^",4)
SET GMRGXPRT(4)=$SELECT($DATA(GMRGIO("RVON")):GMRGIO("RVON"),1:IORVON)
SET GMRGXPRT(5)=$SELECT($DATA(GMRGIO("RVOF")):GMRGIO("RVOF"),1:IORVOFF)
KILL IORVON,IORVOFF
+23 IF $PIECE(GMRGXPRT(1),"^",6)
Begin DoDot:1
+24 SET GMRGXPRT(2)=GMRGXPRT
+25 FOR GMRGXPRT("X")=0:0
SET GMRGXPRT("X")=$FIND(GMRGXPRT(2),"<",GMRGXPRT("X"))
IF GMRGXPRT("X")'>0
QUIT
DO REMOVE
+26 SET GMRGXPRT=GMRGXPRT(2)
+27 QUIT
End DoDot:1
+28 IF GMRGXPRT'["]"
SET GMRGXPRT(2)=GMRGXPRT
+29 IF '$TEST
DO BRACK
+30 SET GMRGXPRT(2)=GMRGXPRT(2)_$SELECT($PIECE(GMRGXPRT(0),"|")="":"",1:" "_$PIECE(GMRGXPRT(0),"|"))
+31 SET GMRGPLN=GMRGXPRT(2)
FOR GMRGXPRT("X")=0:0
IF $EXTRACT(GMRGPLN,$LENGTH(GMRGPLN))'=" "
QUIT
SET GMRGPLN=$EXTRACT(GMRGPLN,1,$LENGTH(GMRGPLN)-1)
+32 IF $PIECE(GMRGXPRT(1),"^",5)=1
GOTO Q1
SET GMRGLEN=$PIECE(GMRGXPRT(1),"^",2)-$PIECE(GMRGXPRT(1),"^")
DO FITLINE^GMRGRUT1
+33 WRITE ?($PIECE(GMRGXPRT(1),"^"))
DO HION
WRITE GMRGPLN(0)
DO HIOF
+34 FOR GMRGXPRT(3)=1:1
IF GMRGPLN(1)=""
QUIT
SET GMRGPLN=GMRGPLN(1)
SET GMRGLEN=$PIECE(GMRGXPRT(1),"^",2)-$PIECE(GMRGXPRT(1),"^")
DO FITLINE^GMRGRUT1
WRITE !,?($PIECE(GMRGXPRT(1),"^"))
DO HION
WRITE GMRGPLN(0)
DO HIOF
Q1 IF $PIECE(GMRGXPRT(1),"^",5)
KILL GMRGXPRT
SET GMRGXPRT=GMRGPLN
+1 IF '$TEST
KILL GMRGXPRT
+2 KILL GMRGPLN,DX,DY
+3 QUIT
REMOVE ;
+1 SET GMRGXPRT("Y")=$FIND(GMRGXPRT(2),">",GMRGXPRT("X"))
IF GMRGXPRT("Y")'>0
QUIT
+2 SET GMRGXPRT(2)=$EXTRACT(GMRGXPRT(2),1,GMRGXPRT("X")-$SELECT($EXTRACT(GMRGXPRT(2),GMRGXPRT("X")-2)'=" ":2,1:3))_$EXTRACT(GMRGXPRT(2),GMRGXPRT("Y"),$LENGTH(GMRGXPRT(2)))
SET GMRGXPRT("X")=0
+3 QUIT
BRACK ;
+1 SET GMRGXPRT(2)=$PIECE(GMRGXPRT,"[")
+2 FOR GMRGXPRT(3)=1:1:($LENGTH(GMRGXPRT,"]")-1)
DO SBR
+3 QUIT
SBR ;
+1 SET GMRGXPRT(2)=GMRGXPRT(2)_$SELECT($PIECE(GMRGXPRT(1),"^",3):"[",1:"")_$SELECT($PIECE(GMRGXPRT(0),"|",GMRGXPRT(3)+1)="":$PIECE($PIECE(GMRGXPRT,"[",GMRGXPRT(3)+1),"]"),1:$PIECE(GMRGXPRT(0),"|",GMRGXPRT(3)+1))
+2 SET GMRGXPRT(2)=GMRGXPRT(2)_$SELECT($PIECE(GMRGXPRT(1),"^",3):"]",1:"")_$PIECE($PIECE(GMRGXPRT,"]",GMRGXPRT(3)+1),"[")
+3 QUIT
HION ;
+1 IF '$PIECE(GMRGXPRT(1),"^",4)
QUIT
SET DX=$X
WRITE GMRGXPRT(4)
IF DX'=$X
SET DY=$Y
XECUTE ^%ZOSF("XY")
+2 QUIT
HIOF ;
+1 IF '$PIECE(GMRGXPRT(1),"^",4)
QUIT
SET DX=$X
WRITE GMRGXPRT(5)
IF DX'=$X
SET DY=$Y
XECUTE ^%ZOSF("XY")
+2 QUIT
DEMPAT ; PRINT PATIENTS DEMOGRAPHIC DATA
+1 WRITE !!,GMRGLIN("*"),!
+2 WRITE "NAME: ",$EXTRACT(GMRGVNAM,1,30),?39,"SSN: ",GMRGVSSN,?58,"DOB: ",GMRGVDOB
+3 IF GMRGVAMV>0
WRITE !,"ADMISSION DATE: ",GMRGVADT,?39,"WARD: ",GMRGVWRD
+4 WRITE !,GMRGLIN("*"),!!
READ "Press return to continue ",X:DTIME
IF X="^"!(X="^^")!'$TEST
SET GMRGOUT=1
QUIT
+5 QUIT
PATDAT ; GIVEN GMRGPAT(X) AS "ALIST" ENTRIES FOR A PARTICULAR AGGY TERM
+1 ; AND GMRGND=TO AGGY TERM WHICH WE ARE LOOKING FOR IN "ALIST",
+2 ; AND GMRGPDA = THE ENTRY IN THE 124.3 FILE IN WHICH WE ARE LOOKING
+3 ; THIS FUNCTION RETURNS GMRGPRT=0 (NOT IN ARRAY),1 (IN ARRAY)
+4 ; AND GMRGPRT(0)=0TH NODE OF ENTRY IN 124.3, FILE
+5 KILL GMRGPRT
SET GMRGPRT=0
SET GMRGPRT(0)=""
FOR GMRG11=0:0
SET GMRG11=$ORDER(GMRGPAT(GMRG11))
IF GMRG11'>0
QUIT
IF GMRGPAT(GMRG11)[("^"_GMRGND_"^")
SET GMRGPRT=1
QUIT
+6 IF 'GMRGPRT
IF $DATA(^GMR(124.3,GMRGPDA,1,"ALIST",GMRGND))
SET GMRG0=GMRGND
SET GMRGND(0)=GMRGND
SET GMRGND(1)=$PIECE(GMRGTERM,"^")
SET GMRGND=GMRGPDA
DO PARST^GMRGRUT0
SET GMRGND=GMRG0
SET GMRGPRT=1
+7 IF GMRGPRT
SET GMRGND(0)=$ORDER(^GMR(124.3,GMRGPDA,1,"B",GMRGND,0))
IF GMRGND(0)>0
SET GMRGPRT(0)=GMRGND(0)_"^"_$SELECT($DATA(^GMR(124.3,GMRGPDA,1,GMRGND(0),0)):$PIECE(^(0),"^",2),1:"")
+8 KILL GMRGND,GMRG0
+9 QUIT
