Routine: GMRGRUT2

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

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

BRACK ;

 S GMRGXPRT(2)=$P(GMRGXPRT,"[")

 F GMRGXPRT(3)=1:1:($L(GMRGXPRT,"]")-1) D SBR

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),"[")

HION ;

 Q:'$P(GMRGXPRT(1),"^",4)  S DX=$X W GMRGXPRT(4) I DX'=$X S DY=$Y X ^%ZOSF("XY")

HIOF ;

 Q:'$P(GMRGXPRT(1),"^",4)  S DX=$X W GMRGXPRT(5) I DX'=$X S DY=$Y X ^%ZOSF("XY")

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

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

GMRGRUT2.m