ORWRP2 ;SLC/DCM - Health Summary Adhoc RPC's ;08/30/2017 11:49
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,109,212,309,332,377**;Dec 17, 1997;Build 582
BB ;Continuation of Blood Bank Report
N DFN,ORY,ORSBHEAD,GCNT,GIOM
S DFN=ORDFN,GCNT=0,GIOM=80
K ^TMP("LRC",$J)
S ROOT=$NA(^TMP("LRC",$J))
D BLEG
Q
BLEG ;Legacy VISTA Blood Bank Report
S ORSBHEAD("BLOOD BANK")=""
D EN^LR7OSUM(.ORY,DFN,,,,GIOM,.ORSBHEAD),TRAN
I '$O(^TMP("LRC",$J,0)) S GCNT=GCNT+1,^TMP("LRC",$J,GCNT,0)="",GCNT=GCNT+1,^TMP("LRC",$J,GCNT,0)="No Blood Bank report available..."
Q
COMP(ORY) ;Get ADHOC sub components (FILE 142.1)
;RPC => ORWRP2 HS COMPONENTS
;Y(i)=(1)I;IFN^(2)Component Name [Abb]^(3)Occ Limit^(4)Time Limit^(5)Header Name^
; (6)Hosp Loc Disp^(7)ICD Text Disp^(8)Prov Narr Disp^(9)Summary Order
D COMP^GMTSADH5(.ORY)
Q
;
COMPABV(ORY) ;Get ADHOC sub components listed by Abbreviation
N I,X,X1,X2,X3
D COMP^GMTSADH5(.ORY)
S I=0
F S I=$O(ORY(I)) Q:'I S X=ORY(I) D
. S X1=$P($P(X,"^",2),"["),X1=$E(X1,1,$L(X1)-1),X2=$P($P(X,"^",2),"[",2),X2=$E(X2,1,$L(X2)-1)
. S:'$L(X2) X2="???" S:'$L($P(X,"^",5)) $P(X,"^",5)=$P($P(X,"^",2),"[") ;***
. S X3=X2_" - "_$P(X,"^",5)_" ",$P(ORY(I),"^",2)=X3
Q
COMPDISP(ORY) ;Get ADHOC sub components listed by Display Name
N I,X,X1,X2,X3
D COMP^GMTSADH5(.ORY)
S I=0
F S I=$O(ORY(I)) Q:'I S X=ORY(I) D
. S X1=$P($P(X,"^",2),"["),X1=$E(X1,1,$L(X1)-1),X2=$P($P(X,"^",2),"[",2),X2=$E(X2,1,$L(X2)-1)
. S:'$L(X2) X2="???" S:'$L($P(X,"^",5)) $P(X,"^",5)=$P($P(X,"^",2),"[") ;***
. S X3=$P(X,"^",5)_" ["_X2_"]",$P(ORY(I),"^",2)=X3
Q
COMPSUB(ORY,ORSUB) ;Get subitems from a predefined Adhoc component
I '$L($T(COMPSUB^GMTSADH5)) Q
D COMPSUB^GMTSADH5(.ORY,ORSUB)
Q
;
SAVLKUP(OK,VAL) ;save Adhoc lookup selection
N ORERR
S OK=""
D EN^XPAR(DUZ_";VA(200,","ORWRP ADHOC LOOKUP",1,VAL,.ORERR)
I ORERR S OK=VAL_":"_ORERR
Q
GETLKUP(ORY) ;Get Adhoc lookup selection
S ORY=$$GET^XPAR("ALL","ORWRP ADHOC LOOKUP",1,"I")
Q
FILES(ORY,ORCOMP) ;Get Files to select from for a component
;RPC => ORWRP2 HS COMP FILES
D FILES^GMTSADH5(.ORY,ORCOMP)
Q
;
FILESEL(OROOT,ORFILE,ORFROM,ORDIR) ;Get file entries for Combobox
;RPC => ORWRP2 HS FILE LOOKUP
D FILESEL^GMTSADH5(.OROOT,ORFILE,ORFROM,ORDIR)
Q
;
REPORT(OROOT,ORCOMPS,ORDFN) ;Build Report from array of Components passed in COMPS
;RPC => ORWRP2 HS REPORT TEXT
;ORCOMPS(i)=array of subcomponents chosen, value is pointer at ^GMT(142,DA(1),1,DA)
Q:'$G(ORDFN)
N GMTSEGC,GMTSEG,ORGMTSEG,ORSEGC,ORSEGI
K ^TMP("ORDATA",$J)
D REPORT^GMTSADH5(.ORGMTSEG,.ORSEGC,.ORSEGI,.ORCOMPS,.ORDFN)
Q:'$O(ORGMTSEG(0))
D START^ORWRP(80,"REPORT1^ORWRP2(.ORGMTSEG,.ORSEGC,.ORSEGI,ORDFN)")
S OROOT=$NA(^TMP("ORDATA",$J,1))
Q
REPORT1(GMTSEG,GMTSEGC,GMTSEGI,DFN) ;
N GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPHDR,GMTSPNM,GMTSRB,GMTSSN,GMTSWRD
N CNT,INC,ORVP,ROOT,SEX,VADM,VAERR,VAIN
S ORVP=DFN
D ADHOC^ORPRS13
Q
;
SUBITEM(ORY,ORTEST) ;Get Subitems for a Test Panel
;RPC => ORWRP2 HS SUBITEMS
D SUBITEM^GMTSADH5(.ORY,ORTEST)
Q
PREPORT(OROOT,ORCOMPS,ORDFN) ;Build Report & Print
;Called from File|Print on Reports Tab after selecting ADHOC Health Summary
;COMPS(i)=array of subcomponents chosen, value is pointer at ^GMT(142,DA(1),1,DA)
Q:'$G(ORDFN)
N GMTSEGC,GMTSEG,ORGMTSEG,ORSEGC,ORSEGI
D REPORT^GMTSADH5(.ORGMTSEG,.ORSEGC,.ORSEGI,.ORCOMPS,.ORDFN)
Q:'$O(ORGMTSEG(0))
M GMTSEG=ORGMTSEG,GMTSEGC=ORSEGC,GMTSEGI=ORSEGI
N GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPHDR,GMTSPNM,GMTSRB,GMTSSN,GMTSWRD
N CNT,INC,ORVP,ROOT,SEX,VADM,VAERR,VAIN
S ORVP=ORDFN
D ADHOC^ORPRS13
Q
TRAN ;Get Transfused Units
N LRDFN,IDT,CNTR,TR,PN,PRODUCT,IX,GMI,X,BPN
S:'$D(GMTS1) GMTS1=6666666 S:'$D(GMTS2) GMTS2=9999999
K ^TMP("LRT",$J)
Q:'$D(^DPT(DFN,"LR")) S LRDFN=+^DPT(DFN,"LR"),IDT=GMTS1-1
I '$D(^LR(LRDFN)) Q
S IDT=0 F S IDT=$O(^LR(LRDFN,1.6,IDT)) Q:+IDT'>0 D
. S TR=$G(^LR(LRDFN,1.6,IDT,0)) D SET
S IDT=0 F S IDT=$O(CNTR(IDT)) Q:+IDT'>0 D
. S ^TMP("LRT",$J,IDT)=9999999-IDT_U,PN=0
. F S PN=$O(CNTR(IDT,PN)) Q:PN'>0 D
.. S PRODUCT=$G(^LAB(66,+PN,0)),^TMP("LRT",$J,$P(PRODUCT,U,2))=$P(PRODUCT,U)
.. S ^TMP("LRT",$J,IDT)=^TMP("LRT",$J,IDT)_CNTR(IDT,PN)_"\"_$P(PRODUCT,U,2)_";"
Q:'$O(^TMP("LRT",$J,0))
S GCNT=+$O(^TMP("LRC",$J,999999999),-1)
D LINE,LN
S ^TMP("LRC",$J,GCNT,0)=$$S(0,CCNT,"Transfused Units"),IX=""
F S IX=$O(^TMP("LRT",$J,IX)) Q:IX="" D
. S GMR=^TMP("LRT",$J,IX),TD=$$FMTE^XLFDT(+GMR)
. Q:TD=0
. S GMA(1)=$P(GMR,U,2),BPN=$L(GMA(1),";")
. I $P(GMA(1),";",BPN)="" S BPN=BPN-1
. F GMI=2:1:BPN S GMA(GMI)="("_$P($P(GMA(1),";",GMI),"\")_") "_$P($P(GMA(1),";",GMI),"\",2)
. S GMA(1)="("_$P($P(GMA(1),";",1),"\")_") "_$P($P(GMA(1),";",1),"\",2)
. D WRT
D KEY
K ^TMP("LRT",$J)
Q
WRT ; Writes the Transfusion Record for each day
N GML,GMI1,GMI2,GMM,GMJ,CL
S GMM=$S(BPN#4:1,1:0),GML=BPN\4+GMM
D LN S ^TMP("LRC",$J,GCNT,0)=$$S(2,.CCNT,TD)
F GMI1=1:1:GML D
. F GMI2=1:1:($S((GMI1=GML)&(BPN#4):BPN#4,1:4)) D
.. S GMJ=((GMI1-1)*4)+GMI2,CL=(((GMI2-1)*15)+14)
.. S ^TMP("LRC",$J,GCNT,0)=$G(^TMP("LRC",$J,GCNT,0))_$$S(CL,.CCNT,GMA(GMJ))
.. I $S(GMI2#4=0:1,GMI2=BPN:1,GMI2+(4*(GMI1-1))=BPN:1,1:0) D LN
Q
SET ; Save Appropriate Data
N COMP,UNITS,TDT,ITDT
S TDT=9999999-IDT,ITDT=9999999-$P(TDT,".")
S UNITS=+$P(TR,U,7) S:UNITS'>0 UNITS=1
S CNTR(ITDT,+$P(TR,U,2))=+$G(CNTR(ITDT,+$P(TR,U,2)))+UNITS
Q
KEY ;
I $O(^TMP("LRT",$J,"A"))'="" D
. D LN
. S ^TMP("LRC",$J,GCNT,0)=$$S(0,CCNT," Blood Product Key: ")
S GMI="A" F S GMI=$O(^TMP("LRT",$J,GMI)) Q:GMI="" D
. S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S(22,CCNT,GMI_" = "_$G(^TMP("LRT",$J,GMI)))
. D LN
. S ^TMP("LRC",$J,GCNT,0)=""
Q
LN ;
S GCNT=GCNT+1,CCNT=1
Q
LINE ;Fill in the global with bank lines
N X
D LN
S X="",$P(X," ",GIOM)="",^TMP("LRC",$J,GCNT,0)=X
Q
S(X,Y,Z) ;Pad over
;X=Column #
;Y=Current length
;Z=Text
;SP=TEXT SENT
;CCNT=Line position after input text
I '$D(Z) Q ""
S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z
S CCNT=$$INC(CCNT,SP)
Q SP
INC(X,Y) ;Character position count
;X=Current count
;Y=Text
S INC=X+$L(Y)
Q INC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWRP2 6272 printed Apr 09, 2024@21:28:44 Page 2
ORWRP2 ;SLC/DCM - Health Summary Adhoc RPC's ;08/30/2017 11:49
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,109,212,309,332,377**;Dec 17, 1997;Build 582
BB ;Continuation of Blood Bank Report
+1 NEW DFN,ORY,ORSBHEAD,GCNT,GIOM
+2 SET DFN=ORDFN
SET GCNT=0
SET GIOM=80
+3 KILL ^TMP("LRC",$JOB)
+4 SET ROOT=$NAME(^TMP("LRC",$JOB))
+5 DO BLEG
+6 QUIT
BLEG ;Legacy VISTA Blood Bank Report
+1 SET ORSBHEAD("BLOOD BANK")=""
+2 DO EN^LR7OSUM(.ORY,DFN,,,,GIOM,.ORSBHEAD)
DO TRAN
+3 IF '$ORDER(^TMP("LRC",$JOB,0))
SET GCNT=GCNT+1
SET ^TMP("LRC",$JOB,GCNT,0)=""
SET GCNT=GCNT+1
SET ^TMP("LRC",$JOB,GCNT,0)="No Blood Bank report available..."
+4 QUIT
COMP(ORY) ;Get ADHOC sub components (FILE 142.1)
+1 ;RPC => ORWRP2 HS COMPONENTS
+2 ;Y(i)=(1)I;IFN^(2)Component Name [Abb]^(3)Occ Limit^(4)Time Limit^(5)Header Name^
+3 ; (6)Hosp Loc Disp^(7)ICD Text Disp^(8)Prov Narr Disp^(9)Summary Order
+4 DO COMP^GMTSADH5(.ORY)
+5 QUIT
+6 ;
COMPABV(ORY) ;Get ADHOC sub components listed by Abbreviation
+1 NEW I,X,X1,X2,X3
+2 DO COMP^GMTSADH5(.ORY)
+3 SET I=0
+4 FOR
SET I=$ORDER(ORY(I))
if 'I
QUIT
SET X=ORY(I)
Begin DoDot:1
+5 SET X1=$PIECE($PIECE(X,"^",2),"[")
SET X1=$EXTRACT(X1,1,$LENGTH(X1)-1)
SET X2=$PIECE($PIECE(X,"^",2),"[",2)
SET X2=$EXTRACT(X2,1,$LENGTH(X2)-1)
+6 ;***
if '$LENGTH(X2)
SET X2="???"
if '$LENGTH($PIECE(X,"^",5))
SET $PIECE(X,"^",5)=$PIECE($PIECE(X,"^",2),"[")
+7 SET X3=X2_" - "_$PIECE(X,"^",5)_" "
SET $PIECE(ORY(I),"^",2)=X3
End DoDot:1
+8 QUIT
COMPDISP(ORY) ;Get ADHOC sub components listed by Display Name
+1 NEW I,X,X1,X2,X3
+2 DO COMP^GMTSADH5(.ORY)
+3 SET I=0
+4 FOR
SET I=$ORDER(ORY(I))
if 'I
QUIT
SET X=ORY(I)
Begin DoDot:1
+5 SET X1=$PIECE($PIECE(X,"^",2),"[")
SET X1=$EXTRACT(X1,1,$LENGTH(X1)-1)
SET X2=$PIECE($PIECE(X,"^",2),"[",2)
SET X2=$EXTRACT(X2,1,$LENGTH(X2)-1)
+6 ;***
if '$LENGTH(X2)
SET X2="???"
if '$LENGTH($PIECE(X,"^",5))
SET $PIECE(X,"^",5)=$PIECE($PIECE(X,"^",2),"[")
+7 SET X3=$PIECE(X,"^",5)_" ["_X2_"]"
SET $PIECE(ORY(I),"^",2)=X3
End DoDot:1
+8 QUIT
COMPSUB(ORY,ORSUB) ;Get subitems from a predefined Adhoc component
+1 IF '$LENGTH($TEXT(COMPSUB^GMTSADH5))
QUIT
+2 DO COMPSUB^GMTSADH5(.ORY,ORSUB)
+3 QUIT
+4 ;
SAVLKUP(OK,VAL) ;save Adhoc lookup selection
+1 NEW ORERR
+2 SET OK=""
+3 DO EN^XPAR(DUZ_";VA(200,","ORWRP ADHOC LOOKUP",1,VAL,.ORERR)
+4 IF ORERR
SET OK=VAL_":"_ORERR
+5 QUIT
GETLKUP(ORY) ;Get Adhoc lookup selection
+1 SET ORY=$$GET^XPAR("ALL","ORWRP ADHOC LOOKUP",1,"I")
+2 QUIT
FILES(ORY,ORCOMP) ;Get Files to select from for a component
+1 ;RPC => ORWRP2 HS COMP FILES
+2 DO FILES^GMTSADH5(.ORY,ORCOMP)
+3 QUIT
+4 ;
FILESEL(OROOT,ORFILE,ORFROM,ORDIR) ;Get file entries for Combobox
+1 ;RPC => ORWRP2 HS FILE LOOKUP
+2 DO FILESEL^GMTSADH5(.OROOT,ORFILE,ORFROM,ORDIR)
+3 QUIT
+4 ;
REPORT(OROOT,ORCOMPS,ORDFN) ;Build Report from array of Components passed in COMPS
+1 ;RPC => ORWRP2 HS REPORT TEXT
+2 ;ORCOMPS(i)=array of subcomponents chosen, value is pointer at ^GMT(142,DA(1),1,DA)
+3 if '$GET(ORDFN)
QUIT
+4 NEW GMTSEGC,GMTSEG,ORGMTSEG,ORSEGC,ORSEGI
+5 KILL ^TMP("ORDATA",$JOB)
+6 DO REPORT^GMTSADH5(.ORGMTSEG,.ORSEGC,.ORSEGI,.ORCOMPS,.ORDFN)
+7 if '$ORDER(ORGMTSEG(0))
QUIT
+8 DO START^ORWRP(80,"REPORT1^ORWRP2(.ORGMTSEG,.ORSEGC,.ORSEGI,ORDFN)")
+9 SET OROOT=$NAME(^TMP("ORDATA",$JOB,1))
+10 QUIT
REPORT1(GMTSEG,GMTSEGC,GMTSEGI,DFN) ;
+1 NEW GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPHDR,GMTSPNM,GMTSRB,GMTSSN,GMTSWRD
+2 NEW CNT,INC,ORVP,ROOT,SEX,VADM,VAERR,VAIN
+3 SET ORVP=DFN
+4 DO ADHOC^ORPRS13
+5 QUIT
+6 ;
SUBITEM(ORY,ORTEST) ;Get Subitems for a Test Panel
+1 ;RPC => ORWRP2 HS SUBITEMS
+2 DO SUBITEM^GMTSADH5(.ORY,ORTEST)
+3 QUIT
PREPORT(OROOT,ORCOMPS,ORDFN) ;Build Report & Print
+1 ;Called from File|Print on Reports Tab after selecting ADHOC Health Summary
+2 ;COMPS(i)=array of subcomponents chosen, value is pointer at ^GMT(142,DA(1),1,DA)
+3 if '$GET(ORDFN)
QUIT
+4 NEW GMTSEGC,GMTSEG,ORGMTSEG,ORSEGC,ORSEGI
+5 DO REPORT^GMTSADH5(.ORGMTSEG,.ORSEGC,.ORSEGI,.ORCOMPS,.ORDFN)
+6 if '$ORDER(ORGMTSEG(0))
QUIT
+7 MERGE GMTSEG=ORGMTSEG,GMTSEGC=ORSEGC,GMTSEGI=ORSEGI
+8 NEW GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPHDR,GMTSPNM,GMTSRB,GMTSSN,GMTSWRD
+9 NEW CNT,INC,ORVP,ROOT,SEX,VADM,VAERR,VAIN
+10 SET ORVP=ORDFN
+11 DO ADHOC^ORPRS13
+12 QUIT
TRAN ;Get Transfused Units
+1 NEW LRDFN,IDT,CNTR,TR,PN,PRODUCT,IX,GMI,X,BPN
+2 if '$DATA(GMTS1)
SET GMTS1=6666666
if '$DATA(GMTS2)
SET GMTS2=9999999
+3 KILL ^TMP("LRT",$JOB)
+4 if '$DATA(^DPT(DFN,"LR"))
QUIT
SET LRDFN=+^DPT(DFN,"LR")
SET IDT=GMTS1-1
+5 IF '$DATA(^LR(LRDFN))
QUIT
+6 SET IDT=0
FOR
SET IDT=$ORDER(^LR(LRDFN,1.6,IDT))
if +IDT'>0
QUIT
Begin DoDot:1
+7 SET TR=$GET(^LR(LRDFN,1.6,IDT,0))
DO SET
End DoDot:1
+8 SET IDT=0
FOR
SET IDT=$ORDER(CNTR(IDT))
if +IDT'>0
QUIT
Begin DoDot:1
+9 SET ^TMP("LRT",$JOB,IDT)=9999999-IDT_U
SET PN=0
+10 FOR
SET PN=$ORDER(CNTR(IDT,PN))
if PN'>0
QUIT
Begin DoDot:2
+11 SET PRODUCT=$GET(^LAB(66,+PN,0))
SET ^TMP("LRT",$JOB,$PIECE(PRODUCT,U,2))=$PIECE(PRODUCT,U)
+12 SET ^TMP("LRT",$JOB,IDT)=^TMP("LRT",$JOB,IDT)_CNTR(IDT,PN)_"\"_$PIECE(PRODUCT,U,2)_";"
End DoDot:2
End DoDot:1
+13 if '$ORDER(^TMP("LRT",$JOB,0))
QUIT
+14 SET GCNT=+$ORDER(^TMP("LRC",$JOB,999999999),-1)
+15 DO LINE
DO LN
+16 SET ^TMP("LRC",$JOB,GCNT,0)=$$S(0,CCNT,"Transfused Units")
SET IX=""
+17 FOR
SET IX=$ORDER(^TMP("LRT",$JOB,IX))
if IX=""
QUIT
Begin DoDot:1
+18 SET GMR=^TMP("LRT",$JOB,IX)
SET TD=$$FMTE^XLFDT(+GMR)
+19 if TD=0
QUIT
+20 SET GMA(1)=$PIECE(GMR,U,2)
SET BPN=$LENGTH(GMA(1),";")
+21 IF $PIECE(GMA(1),";",BPN)=""
SET BPN=BPN-1
+22 FOR GMI=2:1:BPN
SET GMA(GMI)="("_$PIECE($PIECE(GMA(1),";",GMI),"\")_") "_$PIECE($PIECE(GMA(1),";",GMI),"\",2)
+23 SET GMA(1)="("_$PIECE($PIECE(GMA(1),";",1),"\")_") "_$PIECE($PIECE(GMA(1),";",1),"\",2)
+24 DO WRT
End DoDot:1
+25 DO KEY
+26 KILL ^TMP("LRT",$JOB)
+27 QUIT
WRT ; Writes the Transfusion Record for each day
+1 NEW GML,GMI1,GMI2,GMM,GMJ,CL
+2 SET GMM=$SELECT(BPN#4:1,1:0)
SET GML=BPN\4+GMM
+3 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S(2,.CCNT,TD)
+4 FOR GMI1=1:1:GML
Begin DoDot:1
+5 FOR GMI2=1:1:($SELECT((GMI1=GML)&(BPN#4):BPN#4,1:4))
Begin DoDot:2
+6 SET GMJ=((GMI1-1)*4)+GMI2
SET CL=(((GMI2-1)*15)+14)
+7 SET ^TMP("LRC",$JOB,GCNT,0)=$GET(^TMP("LRC",$JOB,GCNT,0))_$$S(CL,.CCNT,GMA(GMJ))
+8 IF $SELECT(GMI2#4=0:1,GMI2=BPN:1,GMI2+(4*(GMI1-1))=BPN:1,1:0)
DO LN
End DoDot:2
End DoDot:1
+9 QUIT
SET ; Save Appropriate Data
+1 NEW COMP,UNITS,TDT,ITDT
+2 SET TDT=9999999-IDT
SET ITDT=9999999-$PIECE(TDT,".")
+3 SET UNITS=+$PIECE(TR,U,7)
if UNITS'>0
SET UNITS=1
+4 SET CNTR(ITDT,+$PIECE(TR,U,2))=+$GET(CNTR(ITDT,+$PIECE(TR,U,2)))+UNITS
+5 QUIT
KEY ;
+1 IF $ORDER(^TMP("LRT",$JOB,"A"))'=""
Begin DoDot:1
+2 DO LN
+3 SET ^TMP("LRC",$JOB,GCNT,0)=$$S(0,CCNT," Blood Product Key: ")
End DoDot:1
+4 SET GMI="A"
FOR
SET GMI=$ORDER(^TMP("LRT",$JOB,GMI))
if GMI=""
QUIT
Begin DoDot:1
+5 SET ^TMP("LRC",$JOB,GCNT,0)=^TMP("LRC",$JOB,GCNT,0)_$$S(22,CCNT,GMI_" = "_$GET(^TMP("LRT",$JOB,GMI)))
+6 DO LN
+7 SET ^TMP("LRC",$JOB,GCNT,0)=""
End DoDot:1
+8 QUIT
LN ;
+1 SET GCNT=GCNT+1
SET CCNT=1
+2 QUIT
LINE ;Fill in the global with bank lines
+1 NEW X
+2 DO LN
+3 SET X=""
SET $PIECE(X," ",GIOM)=""
SET ^TMP("LRC",$JOB,GCNT,0)=X
+4 QUIT
S(X,Y,Z) ;Pad over
+1 ;X=Column #
+2 ;Y=Current length
+3 ;Z=Text
+4 ;SP=TEXT SENT
+5 ;CCNT=Line position after input text
+6 IF '$DATA(Z)
QUIT ""
+7 SET SP=Z
IF X
IF Y
IF X>Y
SET SP=$EXTRACT(" ",1,X-Y)_Z
+8 SET CCNT=$$INC(CCNT,SP)
+9 QUIT SP
INC(X,Y) ;Character position count
+1 ;X=Current count
+2 ;Y=Text
+3 SET INC=X+$LENGTH(Y)
+4 QUIT INC
