- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGRUT2 4471 printed Jan 18, 2025@02:56:47 Page 2
- 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