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

ORCXPND1.m

Go to the documentation of this file.
  1. ORCXPND1 ; SLC/MKB - Expanded Display cont ;May 3, 2021@21:00
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,67,75,89,92,94,148,159,188,172,215,243,280,340,306,350,423,514,527,539,513,585**;Dec 17, 1997;Build 2
  1. ;
  1. ; External References
  1. ; DBIA 2387 ^LAB(60
  1. ; DBIA 3420 ^DPT( file #2
  1. ; DBIA 10035 ^DPT( file #2
  1. ; DBIA 10037 EN^DGRPD
  1. ; DBIA 700 DIS^DGRPDB
  1. ; DBIA 2926 RT^GMRCGUIA
  1. ; DBIA 2925 DT^GMRCSLM2 ^TMP("GMRCR"
  1. ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR"
  1. ; DBIA 2951 EN1^LR7OSBR ^TMP("LRC"
  1. ; DBIA 2952 EN^LR7OSMZ0
  1. ; DBIA 2400 OEL^PSOORRL ^TMP("PS"
  1. ; DBIA 2877 EN3^RAO7PC3
  1. ; DBIA 2877 EN30^RAO7PC3
  1. ; DBIA 1252 $$OUTPTPR^SDUTL3
  1. ; DBIA 1252 $$OUTPTTM^SDUTL3
  1. ; DBIA 1252 $$OUTPTAP^SDUTL3
  1. ; DBIA 2832 RPC^TIUSRV
  1. ; DBIA 10061 DEM^VADPT
  1. ; DBIA 10061 KVAR^VADPT
  1. ; DBIA 10061 OAD^VADPT
  1. ; DBIA 10103 $$FMTE^XLFDT
  1. ; DBIA 4408 DISP^DGIBDSP
  1. ; DBIA 5697 START^SCMCMHTC
  1. ; DBIA 7104 EXT^DGENU
  1. ; DBIA 4192 EXTCAT^DGENA4 and CATEGORY^DGENA4
  1. ; DBIA 3812 FINDCUR^DGENA and GET^DGENA
  1. ; DBIA 3880 CPRS^VBECA3B
  1. ; DBIA 7203 EN^VBECRPT
  1. ; DBIA 7249 GET^VAFCREL
  1. ;
  1. COVER ; -- Cover Sheet
  1. N PKG S PKG=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
  1. D ALLERGY^ORCXPND2:PKG="GMRA",NOTES:PKG="TIU"
  1. Q
  1. NOTES ; -- Progress Notes
  1. N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J)
  1. D RPC^TIUSRV(.ORY,ID)
  1. S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0))
  1. K @ORY
  1. Q
  1. PROBLEMS ; -- Problem List
  1. D PL^ORCXPND4
  1. Q
  1. MEDS ; -- Pharmacy
  1. ;N NODE,ORIFN
  1. K ^TMP("PS",$J)
  1. D OEL^PSOORRL(+ORVP,ID) ;S NODE=$G(^TMP("PS",$J,0)),ORIFN=+$P(NODE,U,11)
  1. S ID=+$P($G(^TMP("PS",$J,0)),U,11) D ORDERS ;DBIA 2400
  1. ;D @($S($P($G(^OR(100,ORIFN,0)),U,11)=$O(^ORD(100.98,"B","IV RX",0)):"IV",1:"DRUG")_"^ORCXPND2")
  1. K ^TMP("PS",$J)
  1. Q
  1. LABS ; -- Laboratory [RESULTS ONLY for ID=OE order #]
  1. N ORIFN,X,SUB,TEST,NAME,SS,IDE,IVDT,TST,CCNT,ORCY,IG,TCNT,XT
  1. K ^TMP("LRRR",$J) ;DBIA 2503
  1. S ORIFN=+ID,IDE=$G(^OR(100,+ID,4)) Q:'$L(IDE) ; OE# -> Lab#
  1. I $G(DFN),$P(IDE,";",4)?1(1"SP",1"CY",1"EM") N XQADATA S XQADATA=$P(IDE,";",4)_U_U_$P(IDE,";",5) D AP^ORCXPND3 Q ;coversheet and orders result display
  1. I $P(IDE,";",5) D RR^LR7OR1(+ORVP,,9999999-$P(IDE,";",5),9999999-$P(IDE,";",5),$P(IDE,";",4)) ;lookup on file 63 first
  1. I '$P(IDE,";",5),+IDE D RR^LR7OR1(+ORVP,IDE) I '$D(^TMP("LRRR",$J,+ORVP)) S $P(IDE,";",1,3)=";;"
  1. K ORCY D TEXT^ORQ12(.ORCY,ORIFN,80)
  1. S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S X=ORCY(IG) D ITEM^ORCXPND(X)
  1. D BLANK^ORCXPND I '$D(^TMP("LRRR",$J,+ORVP)) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
  1. M TEST=^TMP("LRRR",$J,+ORVP) S CCNT=0,SS=""
  1. F S SS=$O(TEST(SS)) Q:SS="" S IVDT=0 F S IVDT=$O(TEST(SS,IVDT)) Q:'IVDT D
  1. . I SS="BB" D
  1. .. I $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q"),$L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D Q ;Transition to VBEC's interface
  1. ... K ^TMP("ORLRC",$J)
  1. ... ;D EN^ORWLR1(DFN) ;RLM
  1. ... D EN^VBECRPT ;RLM
  1. ... I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
  1. ... N I S I=0 F S I=$O(^TMP("ORLRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
  1. ... K ^TMP("ORLRC",$J)
  1. .. K ^TMP("LRC",$J) D EN1^LR7OSBR(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q ;DBIA 2951
  1. ... N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
  1. ... K ^TMP("LRC",$J)
  1. . I SS="MI" K ^TMP("LRC",$J) D EN^LR7OSMZ0(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q
  1. .. N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
  1. .. K ^TMP("LRC",$J)
  1. . I SS="CH" D Q
  1. .. S (TCNT,TST)=0 F S TST=$O(TEST(SS,IVDT,TST)) Q:TST="" S CCNT=0,TCNT=TCNT+1 D
  1. ... I TCNT=1 D
  1. .... S LINE="Collection time: "_$$FMTE^XLFDT(9999999-IVDT,"M")
  1. .... D SETLINE(LINE,.LCNT)
  1. .... D BLANK^ORCXPND
  1. .... S LINE=$$S(1,CCNT," ")_$$S(2,CCNT,"Test Name")_$$S(38,CCNT,"Result")_$$S(48,CCNT,"Units")_$$S(64,CCNT,"Range")
  1. .... D SETLINE(LINE,.LCNT)
  1. .... S CCNT=0,LINE=$$S(1,CCNT," ")_$$S(2,CCNT,"---------")_$$S(38,CCNT,"------")_$$S(48,CCNT,"-----")_$$S(64,CCNT,"-----")
  1. .... D SETLINE(LINE,.LCNT)
  1. .... D:$D(IOUON) SETVIDEO^ORCXPND(LCNT,1,70,IOUON,IOUOFF)
  1. ... I TST S XT=TEST(SS,IVDT,TST),CCNT=0 I +XT D
  1. .... S NAME=$S($L($P(^LAB(60,+XT,0),U))>25:$S($L($P($G(^(.1)),U)):$P(^(.1),U),1:$E($P(^(0),U),1,25)),1:$E($P(^(0),U),1,25))
  1. .... ;OR*3.0*585: Adjusted spacing in line below - $$S(24... instead of $$S(25...
  1. .... ; and add " " before $$S(31
  1. .... S LINE=$$S(1,CCNT,NAME)_$$S(24,CCNT,$J($P(XT,U,2),20))_" "_$$S(31,CCNT,$S($L($P(XT,U,3)):$P(XT,U,3),1:""))_$$S(48,CCNT,$P(XT,U,4))_$$S(58,CCNT,$J($P(XT,U,5),15))
  1. .... D SETLINE(LINE,.LCNT)
  1. .... I $P(XT,U,20) S ^TMP("ORPLS",$J,$P(XT,U,20))=""
  1. .... I $L($P(XT,U,3)),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOINHI,IOINORM)
  1. .... I $P(XT,U,3)["*",$D(IOBON),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOBON_IOINHI,IOBOFF_IOINORM)
  1. ... I TST="N" S LINE=" Comments: " D
  1. .... D SETLINE(LINE,.LCNT)
  1. .... N CMT S CMT=0 F S CMT=$O(TEST(SS,IVDT,"N",CMT)) Q:'CMT S LINE=" "_TEST(SS,IVDT,"N",CMT) D SETLINE(LINE,.LCNT)
  1. I $L($O(^TMP("ORPLS",$J,""))) D SETLINE(" ",.LCNT),SETLINE(" ",.LCNT),SETLINE("===============================================================================",.LCNT),PLS
  1. D SETLINE(" ",.LCNT)
  1. K ^TMP("LRRR",$J)
  1. Q
  1. ;
  1. PLS ; List performing laboratories
  1. N LINE,ORPLS,X
  1. D SETLINE("Performing Lab Sites",.LCNT)
  1. S ORPLS=0
  1. F S ORPLS=$O(^TMP("ORPLS",$J,ORPLS)) Q:ORPLS<1 D
  1. . S LINE=$$LJ^XLFSTR("["_ORPLS_"] ",8)_$$NAME^XUAF4(ORPLS)
  1. . D SETLINE(LINE,.LCNT)
  1. . S X=$$PADD^XUAF4(ORPLS)
  1. . S LINE=$$REPEAT^XLFSTR(" ",8)_$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
  1. . D SETLINE(LINE,.LCNT)
  1. D SETLINE("===============================================================================",.LCNT)
  1. K ^TMP("ORPLS",$J)
  1. Q
  1. ;
  1. SETLINE(LINE,CNT) ;
  1. S CNT=CNT+1,^TMP("ORXPND",$J,CNT,0)=LINE
  1. Q
  1. ;
  1. DELAY ; -- Delayed Orders
  1. NEW ; -- New Orders
  1. ORDERS ; -- Orders
  1. I '$G(ORESULTS) D ORDERS^ORCXPND2 Q
  1. ; -- Results Display (Add more packages as available)
  1. N PKG,TAB,ORIFN
  1. S PKG=+$P($G(^OR(100,+ID,0)),"^",14),PKG=$$NMSP^ORCD(PKG)
  1. S TAB=$S(PKG="LR":"LABS",PKG="GMRC":"CONSULTS",PKG="RA":"XRAYS",1:"")
  1. I '$L(TAB)!(ID'>0) D Q ; no display available
  1. . N ORY,I D TEXT^ORQ12(.ORY,+ID,80)
  1. . S I=0 F S I=$O(ORY(I)) Q:I'>0 D ITEM^ORCXPND(ORY(I))
  1. . D BLANK^ORCXPND
  1. . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="There are no results to report."
  1. I $O(^OR(100,+ID,2,0)) S ORIFN=+ID,ID=0 F S ID=$O(^OR(100,ORIFN,2,ID)) Q:ID<1 I $D(^OR(100,ID,0)) D @TAB
  1. I '$O(^OR(100,+ID,2,0)) D @TAB
  1. Q
  1. REPORTS ; -- Patient Profiles
  1. D EN^ORCXPNDR ; Reports
  1. Q
  1. CONSULTS ; -- Consults
  1. N I,X,SUB,ORTX ;,VALMAR
  1. I $G(ORTAB)="CONSULTS" S X=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
  1. E D TEXT^ORQ12(.ORTX,+ID) S X=ORTX(1),ID=+$G(^OR(100,+ID,4)) ; OE->GMRC order#
  1. D ITEM^ORCXPND(X),BLANK^ORCXPND
  1. I ID'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
  1. I '$G(ORESULTS) D ;DT action
  1. . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Consult No.: "_ID
  1. . N GMRCOER S GMRCOER=2 D DT^GMRCSLM2(ID) S SUB="DT" ;DBIA 2925
  1. I $G(ORESULTS) D RT^GMRCGUIA(ID,"^TMP(""GMRCR"",$J,""RT"")") S SUB="RT"
  1. S I=0 F S I=$O(^TMP("GMRCR",$J,SUB,I)) Q:I'>0 S X=$G(^(I,0)),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;DBIA 2925
  1. K ^TMP("GMRCR",$J)
  1. Q
  1. XRAYS ; -- Radiology
  1. I '$G(ORESULTS) S ID=+ORVP_U_$TR(ID,"-","^") D EN3^RAO7PC3(ID)
  1. I $G(ORESULTS) S ID=+$G(^OR(100,+ID,4)) D EN30^RAO7PC3(ID)
  1. N CASE,PROC,PSET S PSET=$D(^TMP($J,"RAE3",+ORVP,"PRINT_SET"))
  1. S CASE=0 F S CASE=$O(^TMP($J,"RAE3",+ORVP,CASE)) Q:CASE'>0 D
  1. . I PSET S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,"")) D ITEM^ORCXPND(PROC) Q
  1. . S PROC="" F S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC)) Q:PROC="" D ITEM^ORCXPND(PROC),BLANK^ORCXPND,XRPT,BLANK^ORCXPND
  1. I PSET S CASE=$O(^TMP($J,"RAE3",+ORVP,0)),PROC=$O(^(CASE,"")) D BLANK^ORCXPND,XRPT,BLANK^ORCXPND ;printset=list all procs, then one report
  1. K ^TMP($J,"RAE3",+ORVP),^UTILITY($J,"W")
  1. S VALM("RM")=81
  1. Q
  1. ;
  1. XRPT ; -- Body of Report for CASE, PROC
  1. N ORD,X,I
  1. S ORD=$S($L($G(^TMP($J,"RAE3",+ORVP,"ORD"))):^("ORD"),$L($G(^("ORD",CASE))):^(CASE),1:"") I $L(ORD),ORD'=PROC S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Proc Ord: "_ORD
  1. S I=1 F S I=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC,I)) Q:I'>0 S X=^(I),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;Skip pt ID on line 1
  1. Q
  1. ;
  1. SUMMRIES ; -- Discharge Summaries
  1. N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J)
  1. D RPC^TIUSRV(.ORY,ID)
  1. S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0))
  1. K @ORY
  1. Q
  1. PTINQ ; Print Patient Inquiry in List Manager
  1. N DFN,ORI,X
  1. S DFN=+ORVP
  1. D DGINQ(DFN)
  1. S ORI=4,LCNT=0
  1. F S ORI=$O(^TMP("ORDATA",$J,1,ORI)) Q:'ORI S X=^(ORI) D
  1. . S LCNT=LCNT+1
  1. . S ^TMP("ORXPND",$J,LCNT,0)=X
  1. K ^TMP("ORDATA",$J,1)
  1. Q
  1. ;
  1. DGINQ(DFN) ; Patient Inquiry
  1. D START^ORWRP(80,"DGINQB^ORCXPND1(DFN)")
  1. Q
  1. DGINQB(DFN) ; Build Patient Inquiry
  1. N CONTACT,ORDOC,ORTEAM,ORMHP,ORVP,XQORNOD,ORSSTRT,ORSSTOPT,VAOA,CPRSGUI,ORINP,ORATP,ORASS,ORENRI,ORENRD,ORENC,ORESG,A
  1. S ORVP=DFN_";DPT(",XQORNOD=1,CPRSGUI=1
  1. D EN^DGRPD ; MAS Patient Inquiry
  1. I $$GET^XPAR("ALL","ORWPT SHOW CAREGIVER") D
  1. . W !!,"Caregiver Information:"
  1. . N ORRET,ORRETS,ORPRIM,ORSEC,ORGEN,ORA,ORD
  1. . W ! D GET^VAFCREL(.ORRET,DFN)
  1. . I $P(ORRET(0),"^")=-1 W "Caregiver information not currently available: ",$P(ORRET(0),"^",2),! Q
  1. . I $P(ORRET(0),"^")=0 W "No Caregiver information returned." Q
  1. . S ORRETS=0,ORPRIM="",ORSEC="",ORGEN=""
  1. . F S ORRETS=$O(ORRET(ORRETS)) Q:'ORRETS D
  1. .. S ORA=$G(ORRET(ORRETS)) I ORA="" Q
  1. .. I $P(ORA,"^",2)="CGP",$P(ORA,"^",5)="ACTIVE" S ORD("PRIM",ORRETS)=$P(ORA,"^",8) Q
  1. .. I $P(ORA,"^",2)="CGS",$P(ORA,"^",5)="ACTIVE" S ORD("SEC",ORRETS)=$P(ORA,"^",8) Q
  1. .. I $P(ORA,"^",2)="CGG",$P(ORA,"^",5)="ACTIVE" S ORD("GEN",ORRETS)=$P(ORA,"^",8)
  1. .. Q
  1. . I $D(ORD("PRIM")) D
  1. .. W ?5,"Primary Caregiver: "
  1. .. S ORRETS=0
  1. .. F S ORRETS=$O(ORD("PRIM",ORRETS)) Q:'ORRETS W ?24,ORD("PRIM",ORRETS),!
  1. .. W !
  1. . I $D(ORD("SEC")) D
  1. .. W ?3,"Secondary Caregiver: "
  1. .. S ORRETS=0
  1. .. F S ORRETS=$O(ORD("SEC",ORRETS)) Q:'ORRETS W ?24,ORD("SEC",ORRETS),!
  1. .. W !
  1. . I $D(ORD("GEN")) D
  1. .. W ?5,"General Caregiver: "
  1. .. S ORRETS=0
  1. .. F S ORRETS=$O(ORD("GEN",ORRETS)) Q:'ORRETS W ?24,ORD("GEN",ORRETS),!
  1. S ORENRI=$$FINDCUR^DGENA(DFN),A=$$GET^DGENA(ORENRI,.ORENRD),ORENC=$$CATEGORY^DGENA4(DFN),ORESG=$S($G(ORENRD("SUBGRP"))]"":$$EXT^DGENU("SUBGRP",ORENRD("SUBGRP")),1:"")
  1. W !!!,"Enrollment Priority: ",$S($G(ORENRD("PRIORITY"))]"":"GROUP "_$G(ORENRD("PRIORITY")),1:"")_ORESG,?40,"Category: ",$$EXTCAT^DGENA4(ORENC),!!
  1. K CPRSGUI
  1. ;
  1. S ORDOC=$$OUTPTPR^SDUTL3(DFN)
  1. S ORTEAM=$$OUTPTTM^SDUTL3(DFN)
  1. S ORMHP=$$START^SCMCMHTC(DFN) ;Retrieve Mental Health Provider
  1. S ORINP=$G(^DPT(DFN,.104))
  1. S ORATP=$G(^DPT(DFN,.1041))
  1. S ORASS=$P($$OUTPTAP^SDUTL3(DFN,DT),U,2)
  1. I ORDOC!ORTEAM!ORMHP!ORINP!ORATP D
  1. . W !!,"Primary Care Information:"
  1. . I ORDOC W !,"Primary Practitioner: ",$P(ORDOC,"^",2)
  1. . I ORTEAM W !,"Primary Care Team: ",$P(ORTEAM,"^",2)
  1. . I $$INPT^ORWPT1(DFN) D
  1. . . I ORATP W !,"Attending Physician: ",$P($G(^VA(200,+ORATP,0)),U)
  1. . . I ORINP W !,"Inpatient Provider: ",$P($G(^VA(200,+ORINP,0)),U)
  1. . I $L(ORASS) W !,"Associate Provider: ",ORASS
  1. . I ORMHP D
  1. .. W !!,"MH Treatment Information:"
  1. .. W !,"MH Treatment Coord: ",$E($P(ORMHP,"^",2),1,28) D
  1. ... W ?52,"Position: ",$E($P(ORMHP,"^",3),1,18)
  1. .. W !,"MH Treatment Team: ",$E($P(ORMHP,"^",5),1,56)
  1. W !!,"Health Insurance Information:"
  1. D DISP^DGIBDSP ;DBIA #4408
  1. W !!,"Service Connection/Rated Disabilities:"
  1. D DIS^DGRPDB
  1. F CONTACT="N","S" D
  1. .S VAOA("A")=$S(CONTACT="N":"",1:3)
  1. .D OAD^VADPT ; Get NOK Information
  1. .I VAOA(9)]"" D
  1. .. W !!,$S(CONTACT="N":"Next of Kin Information:",1:"Secondary Next of Kin Information:")
  1. .. W !,"Name: ",VAOA(9) ; NOK Name
  1. .. I VAOA(10)]"" W " (",VAOA(10),")" ; Relationship
  1. .. I VAOA(1)]"" W !?7,VAOA(1) ; Address Line 1
  1. .. I VAOA(2)]"" W !?7,VAOA(2) ; Line 2
  1. .. I VAOA(3)]"" W !?7,VAOA(3) ; Line 3
  1. .. I VAOA(4)]"" D
  1. .. . W !?7,VAOA(4) ; City
  1. .. . I VAOA(5)]"" W ", "_$P(VAOA(5),"^",2) ; State
  1. .. . W " ",$P(VAOA(11),"^",2) ; Zip+4
  1. .. I VAOA(8)]"" W !!?7,"Phone number: ",VAOA(8) ; Phone
  1. .. I CONTACT="N",$P($G(^DPT(DFN,.21)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.21),U,11)
  1. .. I CONTACT="S",$P($G(^DPT(DFN,.211)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.211),U,11)
  1. D KVAR^VADPT
  1. Q
  1. TRIM(X) ; Trim Spaces
  1. S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
  1. F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
  1. Q X
  1. S(X,Y,Z) ; Pad Over
  1. ; X=Column #
  1. ; Y=Current Length
  1. ; Z=Text
  1. ; SP=Text Sent
  1. ; CCNT=Line Position After Input Text
  1. I '$D(Z) Q ""
  1. N SP S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z
  1. S CCNT=$$INC(CCNT,SP)
  1. Q SP
  1. INC(X,Y) ; Character Position Count
  1. ; X=Current Count
  1. ; Y=Text
  1. N INC S INC=X+$L(Y)
  1. Q INC