- ORVCODATA01 ;SPFO/AJB - VISTA CUTOVER ;Feb 11, 2021@09:03:38
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**529**;DEC 17, 1997;Build 17
- Q
- ; see ORVCO for list of ICRs/DBIAs
- DEMO(DFN) ; demographic data
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N DEMO,DILOCKTM,DISYS,GBL,NODE13,VAERR,VAOA,VAROOT
- S GBL="^DPT",NODE13=$G(@GBL@(DFN,.13))
- S VAROOT="DEMO",VAOA("A")=1 D OAD^VADPT
- D ADDTXT("Demographic Data"),ADDTXT("================")
- N HP,CP,WP,EC,ECP S HP=$P(NODE13,U),HP=$S(HP="":"None on file.",1:HP),CP=$P(NODE13,U,4),CP=$S(CP="":"None on file.",1:CP),WP=$P(NODE13,U,2),WP=$S(WP="":"None on file.",1:WP)
- D ADDTXT(" Home Phone: "_HP),ADDTXT(" Cell Phone: "_CP),ADDTXT(" Work Phone: "_WP),ADDTXT("")
- S EC=$G(DEMO(9)),EC=$S(EC="":"None on file.",1:EC),ECP=$G(DEMO(8)),ECP=$S(ECP="":"None on file.",1:ECP)
- D ADDTXT("Emergency Contact: "_EC),ADDTXT(" Phone: "_ECP),ADDTXT("")
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Demographics [CPU]")=+$G(@INF@(" Duration","Demographics [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Demographics [SECS]")=+$G(@INF@(" Duration","Demographics [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- SCDIS(DFN) ; service connected/rated disabilities - Integration Agreement #700
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N DATA,DILOCKTM,DISYS,GBL,I,I1,I2,I3,VAEL S GBL="^DG(391)"
- D ADDTXT("Service Connection/Disabilities"),ADDTXT("===============================")
- D ELIG^VADPT S DGKVAR=1
- S DATA=$S(+VAEL(3):" SC Percent: "_+$P(VAEL(3),"^",2)_"%",1:" Service Connected: NO") D ADDTXT(DATA)
- S DATA=" Rated Disabilities: " I 'VAEL(4),$S('$D(@GBL@(+VAEL(6),0)):1,$P(^(0),"^",2):0,1:1) S DATA=DATA_"Not a Veteran" D ADDTXT(DATA) G DISQ
- S GBL="^DPT",GBL(1)="^DIC(31)",I3=0 F I=0:0 S I=$O(@GBL@(DFN,.372,I)) Q:'I D
- . S I1=^(I,0),I2=$S($D(@GBL(1)@(+I1,0)):$P(^(0),"^",1)_" ("_+$P(I1,"^",2)_"%-"_$S($P(I1,"^",3):"SC",$P(I1,"^",3)']"":"Not Specified",1:"NSC")_")",1:""),I3=I3+1
- . S DATA=$$SETSTR^VALM1(I2,$S(I3>1:"",1:DATA),22,$L(I2)) D ADDTXT(DATA)
- I 'I3 S DATA=$$SETSTR^VALM1("None Stated",DATA,22,11) D ADDTXT(DATA)
- D ADDTXT("")
- DISQ I $D(DGKVAR) D KVAR^VADPT K DGKVAR
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Service Connected [CPU]")=+$G(@INF@(" Duration","Service Connected [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Service Connected [SECS]")=+$G(@INF@(" Duration","Service Connected [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- PRF(DFN) ; patient record flag
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N DILOCKTM,DISYS,FLG
- D HASFLG^ORPRF(.FLG,DFN)
- D ADDTXT("Active Patient Record Flags"),ADDTXT("===========================")
- S:+FLG FLG=0 F S FLG=$O(FLG(FLG)) Q:'+FLG D
- . D ADDTXT(" "_$$TITLE^XLFSTR($P(FLG(FLG),U,2)))
- . S FLG(1)=1
- I '+$G(FLG(1)) D ADDTXT("None found.")
- D ADDTXT("")
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Patient Record Flags [CPU]")=+$G(@INF@(" Duration","Patient Record Flags [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Patient Record Flags [SECS]")=+$G(@INF@(" Duration","Patient Record Flags [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- PROBLST(DFN) ; problem list
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N DILOCKTM,DISYS,LCNT,NUM,ORTOTAL ; variables left over by external calls
- N I,J,LIST,TLIST
- D LIST^ORQQPL3(.TLIST,DFN,"A")
- I +TLIST(0) D
- . D ADDTXT("Active Problems"),ADDTXT("===============")
- . S I=0 F S I=$O(TLIST(I)) Q:'+I D
- . . S LIST($S(+$P(TLIST(I),U,6)=0:DT,1:$P(TLIST(I),U,6)),I)=TLIST(I) ; put list in order by date last updated
- . S I="" F S I=$O(LIST(I),-1) Q:'+I S J=0 F S J=$O(LIST(I,J)) Q:'+J D
- . . N X,Y
- . . S X=$P(LIST(I,J),U,3) D WRAP(.X,X,80)
- . . S X=0 F S X=$O(X(X)) Q:'+X D ADDTXT(X(X))
- . . I $P(LIST(I,J),U,15)'=0 K X D GETCOMM^ORQQPL2(.X,+LIST(I,J)) D:+$D(X(1)) ADDTXT(" "_X(1))
- I TLIST(0)'>0 D
- . D ADDTXT("Active Problems"),ADDTXT("==============="),ADDTXT("No active problems found.")
- D ADDTXT("")
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Problem List [CPU]")=+$G(@INF@(" Duration","Problem List [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Problem List [SECS]")=+$G(@INF@(" Duration","Problem List [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- ORDERS(DFN) ; open orders
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N DILOCKTM,DISYS,I,LIST,ORDERS,TYP,XPARSYS
- D AGET^ORWORR(.LIST,DFN,"2^0",1,0,0,"",0) M ORDERS=@LIST K @LIST,ORDERS(.1),LIST
- S I=0 F S I=$O(ORDERS(I)) Q:'+I D
- . S TYP=$P($G(^ORD(100.98,$P(ORDERS(I),U,2),0)),U,2) I TYP="" S TYP=$P($G(^ORD(100.98,$P(ORDERS(I),U,2),0)),U)
- . S LIST(TYP,I)=ORDERS(I)
- D ADDTXT("Active Orders (Including Pending & Recent Activity) - All Services")
- D ADDTXT("==================================================================")
- S TYP="" F S TYP=$O(LIST(TYP),-1) Q:TYP="" S I=0 F S I=$O(LIST(TYP,I)) Q:'+I D
- . N IEN,ORD,STAT,TMP S IEN=+LIST(TYP,I) Q:'+IEN
- . S STAT=$P(^ORD(100.01,$P(^OR(100,IEN,3),U,3),0),U)
- . S TMP="" I $O(LIST(TYP,I),-1)="" S TMP=$S(TYP="CHEMISTRY":"LAB",1:TYP) ; SET TYP ONLY IF IT'S THE FIRST ONE
- . N I,J S I=0 F S I=$O(^OR(100,IEN,8,I)) Q:'+I S J=0 F S J=$O(^OR(100,IEN,8,I,.1,J)) Q:'+J D
- . . N DESC I J=1 D D ADDTXT(ORD) S ORD=""
- . . . S ORD=$$SETSTR^VALM1(TMP,"",1,$L(TMP))
- . . . S DESC=$G(^OR(100,IEN,8,I,.1,J,0)) I $L(DESC)>49 D
- . . . . D WRAP(.DESC,DESC,49) S ORD=$$SETSTR^VALM1(DESC(1),ORD,20,$L(DESC(1)))
- . . . I '+$D(DESC(2)) S ORD=$$SETSTR^VALM1(DESC,ORD,20,$L(DESC))
- . . . S ORD=$$SETSTR^VALM1(STAT,ORD,70,$L(STAT))
- . . I J=1 D Q ; ADD THE EXTRA LINES OF THE DESRIPTION
- . . . N I S I=1 F S I=$O(DESC(I)) Q:'+I S DESC(I)=$$SETSTR^VALM1(DESC(I),"",20,$L(DESC(I))) D ADDTXT(DESC(I))
- . . S ORD=$G(^OR(100,IEN,8,I,.1,J,0)),ORD=$E(ORD,2,$L(ORD))
- . . I $L(ORD)>49 D Q
- . . . D WRAP(.ORD,ORD,49) S ORD="" N I S I=0
- . . . F S I=$O(ORD(I)) Q:'+I S ORD=$$SETSTR^VALM1(ORD(I),ORD,20,$L(ORD(I))) D ADDTXT(ORD) S ORD=""
- . . S ORD=$$SETSTR^VALM1(ORD,"",20,$L(ORD)) D ADDTXT(ORD)
- I '$D(LIST) D ADDTXT("No active orders found.")
- D ADDTXT("")
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Orders [CPU]")=+$G(@INF@(" Duration","Orders [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Orders [SECS]")=+$G(@INF@(" Duration","Orders [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- MEDS(DFN) ; medications
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N DILOCKTM,DISYS,DRG,I,J,LSTDS,LSTRD,ND2P5,RNWDT,SG
- D ADDTXT("********************************************************************************")
- D ADDTXT("* The medication and allergy data below do not contain all of the elements *")
- D ADDTXT("* necessary for the essential medication and allergy list for review. Please *")
- D ADDTXT("* refer to the JLV for the complete list for review. *")
- D ADDTXT("********************************************************************************")
- D ADDTXT("")
- N TMP,X S X="$$LIST^TIULMED("_DFN_",""TMP"",0,1,1,0,0,0)" I @X
- S TMP="" F S TMP=$O(TMP(TMP)) Q:TMP(TMP,0)=" " D ADDTXT(TMP(TMP,0))
- S X="",$P(X,"=",73)="=" D ADDTXT(X)
- F S TMP=$O(TMP(TMP)) Q:'+TMP D ADDTXT(TMP(TMP,0))
- S TMP=$O(TMP(""),-1) I +TMP(TMP,0) D ADDTXT("")
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Medications [CPU]")=+$G(@INF@(" Duration","Medications [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Medications [SECS]")=+$G(@INF@(" Duration","Medications [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- ALLERGIES(DFN) ; allergies
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N DILOCKTM,DISYS,GMA,I,LIST,N D LIST^ORQQAL(.LIST,DFN)
- D ADDTXT("Allergies/Adverse Reactions"),ADDTXT("===========================")
- I $P(LIST(1),U,2)="No allergy assessment found." D ADDTXT($P(LIST(1),U,2))
- S I=0 F S I=$O(LIST(I)) Q:'+I D
- . N X S X=$$SETSTR^VALM1($P(LIST(I),U,2),"",1,29)
- . S X=$$SETSTR^VALM1($P(LIST(I),U,3),X,30,10)
- . N Y S Y=$P(LIST(I),U,4) N REP S REP(",")=", ",Y=$$REPLACE^XLFSTR(Y,.REP)
- . S Y=$$TITLE^XLFSTR(Y) D WRAP(.Y,Y,40)
- . N J S J=0 F S J=$O(Y(J)) Q:'+J D
- . . I J=1 S X=$$SETSTR^VALM1(Y(J),X,40,$L(Y(J))) D ADDTXT(X) Q
- . . S X=$$SETSTR^VALM1(Y(J),"",40,$L(Y(J))) D ADDTXT(X)
- . D ADDTXT("")
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Allergies [CPU]")=+$G(@INF@(" Duration","Allergies [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Allergies [SECS]")=+$G(@INF@(" Duration","Allergies [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- SKIN(DFN) ; skin test
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N D0,NM,DT,GBL,IEN,NODE,ROU
- S GBL="^TMP(""PXS"",$J)" K @GBL S ROU="SKIN^PXRHS04(DFN)" D @ROU
- I $D(@GBL) D ADDTXT("Skin Test Reading Results Admin Reading Facility") D
- . S $P(NM,"=",79)="=" D ADDTXT(NM)
- . S NM="" F S NM=$O(@GBL@(NM)) Q:NM="" S DT=0 F S DT=$O(@GBL@(NM,DT)) Q:'+DT S IEN=0 F S IEN=$O(@GBL@(NM,DT,IEN)) Q:'+IEN D ;S NODE="" F S NODE=$O(@GBL@(NM,DT,IEN,NODE)) Q:NODE="" D
- . . N DATA,NODE0,NODE1,NODEC S NODE0=@GBL@(NM,DT,IEN,0),NODE1=@GBL@(NM,DT,IEN,1),NODEC=@GBL@(NM,DT,IEN,"COM")
- . . S DATA=$P(NODE0,U),DATA=$S($L(DATA)>20:$E(DATA,1,19)_"*",1:DATA),DATA=$$SETSTR^VALM1($P(NODE0,U,5),DATA,23,10),DATA=$$SETSTR^VALM1($P(NODE0,U,4),DATA,31,10)
- . . S DATA=$$SETSTR^VALM1($$FMTE^XLFDT($P(NODE0,U,2),"5DZ"),DATA,40,10),DATA=$$SETSTR^VALM1($$FMTE^XLFDT($P(NODE0,U,6),"5DZ"),DATA,51,10)
- . . N LOC S LOC=$S($P(NODE1,U,3)]"":$P(NODE1,U,3),$P(NODE1,U,4)]"":$P(NODE1,U,4),1:"NO SITE"),LOC=$S($L(LOC)>17:$E(LOC,1,16)_"*",1:LOC)
- . . S DATA=$$SETSTR^VALM1(LOC,DATA,63,17) D ADDTXT(DATA)
- . . I NODEC'="" D ADDTXT(" COMMENTS: "_NODEC)
- I '$D(@GBL) D ADDTXT("Skin Test(s)"),ADDTXT("================="),ADDTXT("No skin tests found.")
- D ADDTXT("")
- K @GBL
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Skin Test [CPU]")=+$G(@INF@(" Duration","Skin Test [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Skin Test [SECS]")=+$G(@INF@(" Duration","Skin Test [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- IMMUINE(DFN) ; immunization
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N D0,NM,DT,GBL,IEN,NODE,ROU
- S GBL="^TMP(""PXI"",$J)" K @GBL S ROU="IMMUN^PXRHS03(DFN,""A"")" D @ROU
- I $D(@GBL) D ADDTXT("Immunization Series Date Facility") D
- . S $P(NM,"=",79)="=" D ADDTXT(NM)
- . S NM="" F S NM=$O(@GBL@(NM)) Q:NM="" S DT=0 F S DT=$O(@GBL@(NM,DT)) Q:'+DT S IEN=0 F S IEN=$O(@GBL@(NM,DT,IEN)) Q:'+IEN D ;S NODE="" F S NODE=$O(@GBL@(NM,DT,IEN,NODE)) Q:NODE="" D
- . . N DATA,NODE0,NODE1 S NODE0=@GBL@(NM,DT,IEN,0),NODE1=@GBL@(NM,DT,IEN,1)
- . . S DATA=$P(NODE0,U),DATA=$S($L(DATA)>40:$E(DATA,1,39)_"*",1:DATA),DATA=$$SETSTR^VALM1($P(NODE0,U,4),DATA,43,2),DATA=$$SETSTR^VALM1($$FMTE^XLFDT($P(NODE0,U,3),"5DZ"),DATA,51,10)
- . . N LOC S LOC=$S($P(NODE1,U,3)]"":$P(NODE1,U,3),$P(NODE1,U,4)]"":$P(NODE1,U,4),1:"NO SITE"),LOC=$S($L(LOC)>18:$E(LOC,1,17)_"*",1:LOC)
- . . S DATA=$$SETSTR^VALM1(LOC,DATA,63,18) D ADDTXT(DATA) I $P(NODE0,U,6)]"" D ADDTXT(" REACTION: "_$$SENTENCE^XLFSTR($P(NODE0,U,6)))
- I '$D(@GBL) D ADDTXT("Immunization"),ADDTXT("================="),ADDTXT("No immunizations found.")
- D ADDTXT("") K @GBL
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Immunizations [CPU]")=+$G(@INF@(" Duration","Immunizations [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Immunizations [SECS]")=+$G(@INF@(" Duration","Immunizations [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- IMAG(DFN) ; imaging
- N CPUCLK,DATE,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- N DILOCKTM,DISYS,RACNI,RADATA,RAMDIV,RAORDER,RAWHOVER,ROOT,VALM
- S DATE("START")=9999999-$$FMADD^XLFDT(DT,-1826),DATE("FINISH")=9999999-(DT_.235959),DATE("BEGIN")=$$FMADD^XLFDT(DT,-1826),DATE("END")=DT_.235959
- D RIM^ORDV08(.ROOT,DATE("START"),DATE("FINISH"),100,DATE("BEGIN"),DATE("END"),"IGET;ORDV08;OR_R18")
- I $D(@ROOT) D
- . N TMP S TMP="Imaging ["_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-1826))_" TO "_$$FMTE^XLFDT(DT)_"]",$P(TMP(1),"=",$L(TMP))="="
- . D ADDTXT(TMP),ADDTXT(TMP(1))
- . N I,J S I=0 F S I=$O(@ROOT@(I)) Q:'+I D
- . . N OUT
- . . S OUT=$P(@ROOT@(I,"WP",2),U,2)
- . . S OUT=$$SETSTR^VALM1($P(@ROOT@(I,"WP",3),U,2),OUT,22,$L($P(@ROOT@(I,"WP",3),U,2)))
- . . S OUT=$$SETSTR^VALM1($P(@ROOT@(I,"WP",4),U,2),OUT,70,$L($P(@ROOT@(I,"WP",4),U,2)))
- . . D ADDTXT(OUT)
- I '$D(@ROOT) D ADDTXT("Imaging"),ADDTXT("======="),ADDTXT("No imaging found.")
- D ADDTXT("") K @ROOT
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Imaging [CPU]")=+$G(@INF@(" Duration","Imaging [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Imaging [SECS]")=+$G(@INF@(" Duration","Imaging [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- FUTURE(DFN) ; future outpatient encounters
- N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
- D ADDTXT("Future Appointments"),ADDTXT("===================")
- N DATA,VAERR,VAROOT,VDT S VAROOT="Data"
- D SDA^VADPT
- N I S I=0 F S I=$O(@VAROOT@(I)) Q:'+I S VDT=$P(@VAROOT@(I,"I"),U) D
- . S DATA(9999999-VDT)=VDT_U_$P(@VAROOT@(I,"E"),U,2,3)
- S VDT=0 F S VDT=$O(DATA(VDT)) Q:'+VDT D
- . S DATA=$TR($$FMTE^XLFDT(+DATA(VDT),"5MZ"),"@"," "),DATA=$$SETSTR^VALM1($P(DATA(VDT),U,2),DATA,19,56),DATA=$$SETSTR^VALM1($P(DATA(VDT),U,3),DATA,58,21)
- . D ADDTXT(DATA)
- I '$D(@VAROOT) D ADDTXT("No future appointments found.")
- D ADDTXT("")
- K @VAROOT
- S CPUCLK(2)=$$CPUTIME^XLFSHAN
- S @INF@(" Duration","Future Visits [CPU]")=+$G(@INF@(" Duration","Future Visits [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- S STOP=$H
- S @INF@(" Duration","Future Visits [SECS]")=+$G(@INF@(" Duration","Future Visits [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- Q
- LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;
- N DILOCKTM,DISYS
- Q $$FIND1^DIC(FILE,$G(IENS),$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"ERR")
- ADDTXT(DATA) ;
- S DOCTXT=DOCTXT+1
- S DOCTXT(DOCTXT,0)=DATA
- Q
- WRAP(OUT,TEXT,LENGTH) ;
- N TIUFI,TIUFJ,LINE,TIUFT1,TIUFT2,TIUFY
- I $G(TEXT)']"" Q
- F TIUFI=1:1 D Q:TIUFI=$L(TEXT," ")
- . S OUT=$P(TEXT," ",TIUFI)
- . I $L(OUT)>LENGTH D
- . . S TIUFT1=$E(OUT,1,LENGTH),TIUFT2=$E(OUT,LENGTH+1,$L(OUT))
- . . S $P(TEXT," ",TIUFI)=TIUFT1_" "_TIUFT2
- S LINE=1,OUT(1)=$P(TEXT," ")
- F TIUFI=2:1 D Q:TIUFI'<$L(TEXT," ")
- . S:$L($G(OUT(LINE))_" "_$P(TEXT," ",TIUFI))>LENGTH LINE=LINE+1,TIUFY=1
- . S OUT(LINE)=$G(OUT(LINE))_$S(+$G(TIUFY):"",1:" ")_$P(TEXT," ",TIUFI),TIUFY=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORVCODATA01 14732 printed Jan 18, 2025@03:35:55 Page 2
- ORVCODATA01 ;SPFO/AJB - VISTA CUTOVER ;Feb 11, 2021@09:03:38
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**529**;DEC 17, 1997;Build 17
- +2 QUIT
- +3 ; see ORVCO for list of ICRs/DBIAs
- DEMO(DFN) ; demographic data
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 NEW DEMO,DILOCKTM,DISYS,GBL,NODE13,VAERR,VAOA,VAROOT
- +3 SET GBL="^DPT"
- SET NODE13=$GET(@GBL@(DFN,.13))
- +4 SET VAROOT="DEMO"
- SET VAOA("A")=1
- DO OAD^VADPT
- +5 DO ADDTXT("Demographic Data")
- DO ADDTXT("================")
- +6 NEW HP,CP,WP,EC,ECP
- SET HP=$PIECE(NODE13,U)
- SET HP=$SELECT(HP="":"None on file.",1:HP)
- SET CP=$PIECE(NODE13,U,4)
- SET CP=$SELECT(CP="":"None on file.",1:CP)
- SET WP=$PIECE(NODE13,U,2)
- SET WP=$SELECT(WP="":"None on file.",1:WP)
- +7 DO ADDTXT(" Home Phone: "_HP)
- DO ADDTXT(" Cell Phone: "_CP)
- DO ADDTXT(" Work Phone: "_WP)
- DO ADDTXT("")
- +8 SET EC=$GET(DEMO(9))
- SET EC=$SELECT(EC="":"None on file.",1:EC)
- SET ECP=$GET(DEMO(8))
- SET ECP=$SELECT(ECP="":"None on file.",1:ECP)
- +9 DO ADDTXT("Emergency Contact: "_EC)
- DO ADDTXT(" Phone: "_ECP)
- DO ADDTXT("")
- +10 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +11 SET @INF@(" Duration","Demographics [CPU]")=+$GET(@INF@(" Duration","Demographics [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +12 SET STOP=$HOROLOG
- +13 SET @INF@(" Duration","Demographics [SECS]")=+$GET(@INF@(" Duration","Demographics [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +14 QUIT
- SCDIS(DFN) ; service connected/rated disabilities - Integration Agreement #700
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 NEW DATA,DILOCKTM,DISYS,GBL,I,I1,I2,I3,VAEL
- SET GBL="^DG(391)"
- +3 DO ADDTXT("Service Connection/Disabilities")
- DO ADDTXT("===============================")
- +4 DO ELIG^VADPT
- SET DGKVAR=1
- +5 SET DATA=$SELECT(+VAEL(3):" SC Percent: "_+$PIECE(VAEL(3),"^",2)_"%",1:" Service Connected: NO")
- DO ADDTXT(DATA)
- +6 SET DATA=" Rated Disabilities: "
- IF 'VAEL(4)
- IF $SELECT('$DATA(@GBL@(+VAEL(6),0)):1,$PIECE(^(0),"^",2):0,1:1)
- SET DATA=DATA_"Not a Veteran"
- DO ADDTXT(DATA)
- GOTO DISQ
- +7 SET GBL="^DPT"
- SET GBL(1)="^DIC(31)"
- SET I3=0
- FOR I=0:0
- SET I=$ORDER(@GBL@(DFN,.372,I))
- if 'I
- QUIT
- Begin DoDot:1
- +8 SET I1=^(I,0)
- SET I2=$SELECT($DATA(@GBL(1)@(+I1,0)):$PIECE(^(0),"^",1)_" ("_+$PIECE(I1,"^",2)_"%-"_$SELECT($PIECE(I1,"^",3):"SC",$PIECE(I1,"^",3)']"":"Not Specified",1:"NSC")_")",1:"")
- SET I3=I3+1
- +9 SET DATA=$$SETSTR^VALM1(I2,$SELECT(I3>1:"",1:DATA),22,$LENGTH(I2))
- DO ADDTXT(DATA)
- End DoDot:1
- +10 IF 'I3
- SET DATA=$$SETSTR^VALM1("None Stated",DATA,22,11)
- DO ADDTXT(DATA)
- +11 DO ADDTXT("")
- DISQ IF $DATA(DGKVAR)
- DO KVAR^VADPT
- KILL DGKVAR
- +1 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +2 SET @INF@(" Duration","Service Connected [CPU]")=+$GET(@INF@(" Duration","Service Connected [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +3 SET STOP=$HOROLOG
- +4 SET @INF@(" Duration","Service Connected [SECS]")=+$GET(@INF@(" Duration","Service Connected [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +5 QUIT
- PRF(DFN) ; patient record flag
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 NEW DILOCKTM,DISYS,FLG
- +3 DO HASFLG^ORPRF(.FLG,DFN)
- +4 DO ADDTXT("Active Patient Record Flags")
- DO ADDTXT("===========================")
- +5 if +FLG
- SET FLG=0
- FOR
- SET FLG=$ORDER(FLG(FLG))
- if '+FLG
- QUIT
- Begin DoDot:1
- +6 DO ADDTXT(" "_$$TITLE^XLFSTR($PIECE(FLG(FLG),U,2)))
- +7 SET FLG(1)=1
- End DoDot:1
- +8 IF '+$GET(FLG(1))
- DO ADDTXT("None found.")
- +9 DO ADDTXT("")
- +10 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +11 SET @INF@(" Duration","Patient Record Flags [CPU]")=+$GET(@INF@(" Duration","Patient Record Flags [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +12 SET STOP=$HOROLOG
- +13 SET @INF@(" Duration","Patient Record Flags [SECS]")=+$GET(@INF@(" Duration","Patient Record Flags [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +14 QUIT
- PROBLST(DFN) ; problem list
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 ; variables left over by external calls
- NEW DILOCKTM,DISYS,LCNT,NUM,ORTOTAL
- +3 NEW I,J,LIST,TLIST
- +4 DO LIST^ORQQPL3(.TLIST,DFN,"A")
- +5 IF +TLIST(0)
- Begin DoDot:1
- +6 DO ADDTXT("Active Problems")
- DO ADDTXT("===============")
- +7 SET I=0
- FOR
- SET I=$ORDER(TLIST(I))
- if '+I
- QUIT
- Begin DoDot:2
- +8 ; put list in order by date last updated
- SET LIST($SELECT(+$PIECE(TLIST(I),U,6)=0:DT,1:$PIECE(TLIST(I),U,6)),I)=TLIST(I)
- End DoDot:2
- +9 SET I=""
- FOR
- SET I=$ORDER(LIST(I),-1)
- if '+I
- QUIT
- SET J=0
- FOR
- SET J=$ORDER(LIST(I,J))
- if '+J
- QUIT
- Begin DoDot:2
- +10 NEW X,Y
- +11 SET X=$PIECE(LIST(I,J),U,3)
- DO WRAP(.X,X,80)
- +12 SET X=0
- FOR
- SET X=$ORDER(X(X))
- if '+X
- QUIT
- DO ADDTXT(X(X))
- +13 IF $PIECE(LIST(I,J),U,15)'=0
- KILL X
- DO GETCOMM^ORQQPL2(.X,+LIST(I,J))
- if +$DATA(X(1))
- DO ADDTXT(" "_X(1))
- End DoDot:2
- End DoDot:1
- +14 IF TLIST(0)'>0
- Begin DoDot:1
- +15 DO ADDTXT("Active Problems")
- DO ADDTXT("===============")
- DO ADDTXT("No active problems found.")
- End DoDot:1
- +16 DO ADDTXT("")
- +17 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +18 SET @INF@(" Duration","Problem List [CPU]")=+$GET(@INF@(" Duration","Problem List [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +19 SET STOP=$HOROLOG
- +20 SET @INF@(" Duration","Problem List [SECS]")=+$GET(@INF@(" Duration","Problem List [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +21 QUIT
- ORDERS(DFN) ; open orders
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 NEW DILOCKTM,DISYS,I,LIST,ORDERS,TYP,XPARSYS
- +3 DO AGET^ORWORR(.LIST,DFN,"2^0",1,0,0,"",0)
- MERGE ORDERS=@LIST
- KILL @LIST,ORDERS(.1),LIST
- +4 SET I=0
- FOR
- SET I=$ORDER(ORDERS(I))
- if '+I
- QUIT
- Begin DoDot:1
- +5 SET TYP=$PIECE($GET(^ORD(100.98,$PIECE(ORDERS(I),U,2),0)),U,2)
- IF TYP=""
- SET TYP=$PIECE($GET(^ORD(100.98,$PIECE(ORDERS(I),U,2),0)),U)
- +6 SET LIST(TYP,I)=ORDERS(I)
- End DoDot:1
- +7 DO ADDTXT("Active Orders (Including Pending & Recent Activity) - All Services")
- +8 DO ADDTXT("==================================================================")
- +9 SET TYP=""
- FOR
- SET TYP=$ORDER(LIST(TYP),-1)
- if TYP=""
- QUIT
- SET I=0
- FOR
- SET I=$ORDER(LIST(TYP,I))
- if '+I
- QUIT
- Begin DoDot:1
- +10 NEW IEN,ORD,STAT,TMP
- SET IEN=+LIST(TYP,I)
- if '+IEN
- QUIT
- +11 SET STAT=$PIECE(^ORD(100.01,$PIECE(^OR(100,IEN,3),U,3),0),U)
- +12 ; SET TYP ONLY IF IT'S THE FIRST ONE
- SET TMP=""
- IF $ORDER(LIST(TYP,I),-1)=""
- SET TMP=$SELECT(TYP="CHEMISTRY":"LAB",1:TYP)
- +13 NEW I,J
- SET I=0
- FOR
- SET I=$ORDER(^OR(100,IEN,8,I))
- if '+I
- QUIT
- SET J=0
- FOR
- SET J=$ORDER(^OR(100,IEN,8,I,.1,J))
- if '+J
- QUIT
- Begin DoDot:2
- +14 NEW DESC
- IF J=1
- Begin DoDot:3
- +15 SET ORD=$$SETSTR^VALM1(TMP,"",1,$LENGTH(TMP))
- +16 SET DESC=$GET(^OR(100,IEN,8,I,.1,J,0))
- IF $LENGTH(DESC)>49
- Begin DoDot:4
- +17 DO WRAP(.DESC,DESC,49)
- SET ORD=$$SETSTR^VALM1(DESC(1),ORD,20,$LENGTH(DESC(1)))
- End DoDot:4
- +18 IF '+$DATA(DESC(2))
- SET ORD=$$SETSTR^VALM1(DESC,ORD,20,$LENGTH(DESC))
- +19 SET ORD=$$SETSTR^VALM1(STAT,ORD,70,$LENGTH(STAT))
- End DoDot:3
- DO ADDTXT(ORD)
- SET ORD=""
- +20 ; ADD THE EXTRA LINES OF THE DESRIPTION
- IF J=1
- Begin DoDot:3
- +21 NEW I
- SET I=1
- FOR
- SET I=$ORDER(DESC(I))
- if '+I
- QUIT
- SET DESC(I)=$$SETSTR^VALM1(DESC(I),"",20,$LENGTH(DESC(I)))
- DO ADDTXT(DESC(I))
- End DoDot:3
- QUIT
- +22 SET ORD=$GET(^OR(100,IEN,8,I,.1,J,0))
- SET ORD=$EXTRACT(ORD,2,$LENGTH(ORD))
- +23 IF $LENGTH(ORD)>49
- Begin DoDot:3
- +24 DO WRAP(.ORD,ORD,49)
- SET ORD=""
- NEW I
- SET I=0
- +25 FOR
- SET I=$ORDER(ORD(I))
- if '+I
- QUIT
- SET ORD=$$SETSTR^VALM1(ORD(I),ORD,20,$LENGTH(ORD(I)))
- DO ADDTXT(ORD)
- SET ORD=""
- End DoDot:3
- QUIT
- +26 SET ORD=$$SETSTR^VALM1(ORD,"",20,$LENGTH(ORD))
- DO ADDTXT(ORD)
- End DoDot:2
- End DoDot:1
- +27 IF '$DATA(LIST)
- DO ADDTXT("No active orders found.")
- +28 DO ADDTXT("")
- +29 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +30 SET @INF@(" Duration","Orders [CPU]")=+$GET(@INF@(" Duration","Orders [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +31 SET STOP=$HOROLOG
- +32 SET @INF@(" Duration","Orders [SECS]")=+$GET(@INF@(" Duration","Orders [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +33 QUIT
- MEDS(DFN) ; medications
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 NEW DILOCKTM,DISYS,DRG,I,J,LSTDS,LSTRD,ND2P5,RNWDT,SG
- +3 DO ADDTXT("********************************************************************************")
- +4 DO ADDTXT("* The medication and allergy data below do not contain all of the elements *")
- +5 DO ADDTXT("* necessary for the essential medication and allergy list for review. Please *")
- +6 DO ADDTXT("* refer to the JLV for the complete list for review. *")
- +7 DO ADDTXT("********************************************************************************")
- +8 DO ADDTXT("")
- +9 NEW TMP,X
- SET X="$$LIST^TIULMED("_DFN_",""TMP"",0,1,1,0,0,0)"
- IF @X
- +10 SET TMP=""
- FOR
- SET TMP=$ORDER(TMP(TMP))
- if TMP(TMP,0)=" "
- QUIT
- DO ADDTXT(TMP(TMP,0))
- +11 SET X=""
- SET $PIECE(X,"=",73)="="
- DO ADDTXT(X)
- +12 FOR
- SET TMP=$ORDER(TMP(TMP))
- if '+TMP
- QUIT
- DO ADDTXT(TMP(TMP,0))
- +13 SET TMP=$ORDER(TMP(""),-1)
- IF +TMP(TMP,0)
- DO ADDTXT("")
- +14 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +15 SET @INF@(" Duration","Medications [CPU]")=+$GET(@INF@(" Duration","Medications [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +16 SET STOP=$HOROLOG
- +17 SET @INF@(" Duration","Medications [SECS]")=+$GET(@INF@(" Duration","Medications [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +18 QUIT
- ALLERGIES(DFN) ; allergies
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 NEW DILOCKTM,DISYS,GMA,I,LIST,N
- DO LIST^ORQQAL(.LIST,DFN)
- +3 DO ADDTXT("Allergies/Adverse Reactions")
- DO ADDTXT("===========================")
- +4 IF $PIECE(LIST(1),U,2)="No allergy assessment found."
- DO ADDTXT($PIECE(LIST(1),U,2))
- +5 SET I=0
- FOR
- SET I=$ORDER(LIST(I))
- if '+I
- QUIT
- Begin DoDot:1
- +6 NEW X
- SET X=$$SETSTR^VALM1($PIECE(LIST(I),U,2),"",1,29)
- +7 SET X=$$SETSTR^VALM1($PIECE(LIST(I),U,3),X,30,10)
- +8 NEW Y
- SET Y=$PIECE(LIST(I),U,4)
- NEW REP
- SET REP(",")=", "
- SET Y=$$REPLACE^XLFSTR(Y,.REP)
- +9 SET Y=$$TITLE^XLFSTR(Y)
- DO WRAP(.Y,Y,40)
- +10 NEW J
- SET J=0
- FOR
- SET J=$ORDER(Y(J))
- if '+J
- QUIT
- Begin DoDot:2
- +11 IF J=1
- SET X=$$SETSTR^VALM1(Y(J),X,40,$LENGTH(Y(J)))
- DO ADDTXT(X)
- QUIT
- +12 SET X=$$SETSTR^VALM1(Y(J),"",40,$LENGTH(Y(J)))
- DO ADDTXT(X)
- End DoDot:2
- +13 DO ADDTXT("")
- End DoDot:1
- +14 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +15 SET @INF@(" Duration","Allergies [CPU]")=+$GET(@INF@(" Duration","Allergies [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +16 SET STOP=$HOROLOG
- +17 SET @INF@(" Duration","Allergies [SECS]")=+$GET(@INF@(" Duration","Allergies [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +18 QUIT
- SKIN(DFN) ; skin test
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 NEW D0,NM,DT,GBL,IEN,NODE,ROU
- +3 SET GBL="^TMP(""PXS"",$J)"
- KILL @GBL
- SET ROU="SKIN^PXRHS04(DFN)"
- DO @ROU
- +4 IF $DATA(@GBL)
- DO ADDTXT("Skin Test Reading Results Admin Reading Facility")
- Begin DoDot:1
- +5 SET $PIECE(NM,"=",79)="="
- DO ADDTXT(NM)
- +6 ;S NODE="" F S NODE=$O(@GBL@(NM,DT,IEN,NODE)) Q:NODE="" D
- SET NM=""
- FOR
- SET NM=$ORDER(@GBL@(NM))
- if NM=""
- QUIT
- SET DT=0
- FOR
- SET DT=$ORDER(@GBL@(NM,DT))
- if '+DT
- QUIT
- SET IEN=0
- FOR
- SET IEN=$ORDER(@GBL@(NM,DT,IEN))
- if '+IEN
- QUIT
- Begin DoDot:2
- +7 NEW DATA,NODE0,NODE1,NODEC
- SET NODE0=@GBL@(NM,DT,IEN,0)
- SET NODE1=@GBL@(NM,DT,IEN,1)
- SET NODEC=@GBL@(NM,DT,IEN,"COM")
- +8 SET DATA=$PIECE(NODE0,U)
- SET DATA=$SELECT($LENGTH(DATA)>20:$EXTRACT(DATA,1,19)_"*",1:DATA)
- SET DATA=$$SETSTR^VALM1($PIECE(NODE0,U,5),DATA,23,10)
- SET DATA=$$SETSTR^VALM1($PIECE(NODE0,U,4),DATA,31,10)
- +9 SET DATA=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(NODE0,U,2),"5DZ"),DATA,40,10)
- SET DATA=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(NODE0,U,6),"5DZ"),DATA,51,10)
- +10 NEW LOC
- SET LOC=$SELECT($PIECE(NODE1,U,3)]"":$PIECE(NODE1,U,3),$PIECE(NODE1,U,4)]"":$PIECE(NODE1,U,4),1:"NO SITE")
- SET LOC=$SELECT($LENGTH(LOC)>17:$EXTRACT(LOC,1,16)_"*",1:LOC)
- +11 SET DATA=$$SETSTR^VALM1(LOC,DATA,63,17)
- DO ADDTXT(DATA)
- +12 IF NODEC'=""
- DO ADDTXT(" COMMENTS: "_NODEC)
- End DoDot:2
- End DoDot:1
- +13 IF '$DATA(@GBL)
- DO ADDTXT("Skin Test(s)")
- DO ADDTXT("=================")
- DO ADDTXT("No skin tests found.")
- +14 DO ADDTXT("")
- +15 KILL @GBL
- +16 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +17 SET @INF@(" Duration","Skin Test [CPU]")=+$GET(@INF@(" Duration","Skin Test [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +18 SET STOP=$HOROLOG
- +19 SET @INF@(" Duration","Skin Test [SECS]")=+$GET(@INF@(" Duration","Skin Test [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +20 QUIT
- IMMUINE(DFN) ; immunization
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 NEW D0,NM,DT,GBL,IEN,NODE,ROU
- +3 SET GBL="^TMP(""PXI"",$J)"
- KILL @GBL
- SET ROU="IMMUN^PXRHS03(DFN,""A"")"
- DO @ROU
- +4 IF $DATA(@GBL)
- DO ADDTXT("Immunization Series Date Facility")
- Begin DoDot:1
- +5 SET $PIECE(NM,"=",79)="="
- DO ADDTXT(NM)
- +6 ;S NODE="" F S NODE=$O(@GBL@(NM,DT,IEN,NODE)) Q:NODE="" D
- SET NM=""
- FOR
- SET NM=$ORDER(@GBL@(NM))
- if NM=""
- QUIT
- SET DT=0
- FOR
- SET DT=$ORDER(@GBL@(NM,DT))
- if '+DT
- QUIT
- SET IEN=0
- FOR
- SET IEN=$ORDER(@GBL@(NM,DT,IEN))
- if '+IEN
- QUIT
- Begin DoDot:2
- +7 NEW DATA,NODE0,NODE1
- SET NODE0=@GBL@(NM,DT,IEN,0)
- SET NODE1=@GBL@(NM,DT,IEN,1)
- +8 SET DATA=$PIECE(NODE0,U)
- SET DATA=$SELECT($LENGTH(DATA)>40:$EXTRACT(DATA,1,39)_"*",1:DATA)
- SET DATA=$$SETSTR^VALM1($PIECE(NODE0,U,4),DATA,43,2)
- SET DATA=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(NODE0,U,3),"5DZ"),DATA,51,10)
- +9 NEW LOC
- SET LOC=$SELECT($PIECE(NODE1,U,3)]"":$PIECE(NODE1,U,3),$PIECE(NODE1,U,4)]"":$PIECE(NODE1,U,4),1:"NO SITE")
- SET LOC=$SELECT($LENGTH(LOC)>18:$EXTRACT(LOC,1,17)_"*",1:LOC)
- +10 SET DATA=$$SETSTR^VALM1(LOC,DATA,63,18)
- DO ADDTXT(DATA)
- IF $PIECE(NODE0,U,6)]""
- DO ADDTXT(" REACTION: "_$$SENTENCE^XLFSTR($PIECE(NODE0,U,6)))
- End DoDot:2
- End DoDot:1
- +11 IF '$DATA(@GBL)
- DO ADDTXT("Immunization")
- DO ADDTXT("=================")
- DO ADDTXT("No immunizations found.")
- +12 DO ADDTXT("")
- KILL @GBL
- +13 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +14 SET @INF@(" Duration","Immunizations [CPU]")=+$GET(@INF@(" Duration","Immunizations [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +15 SET STOP=$HOROLOG
- +16 SET @INF@(" Duration","Immunizations [SECS]")=+$GET(@INF@(" Duration","Immunizations [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +17 QUIT
- IMAG(DFN) ; imaging
- +1 NEW CPUCLK,DATE,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 NEW DILOCKTM,DISYS,RACNI,RADATA,RAMDIV,RAORDER,RAWHOVER,ROOT,VALM
- +3 SET DATE("START")=9999999-$$FMADD^XLFDT(DT,-1826)
- SET DATE("FINISH")=9999999-(DT_.235959)
- SET DATE("BEGIN")=$$FMADD^XLFDT(DT,-1826)
- SET DATE("END")=DT_.235959
- +4 DO RIM^ORDV08(.ROOT,DATE("START"),DATE("FINISH"),100,DATE("BEGIN"),DATE("END"),"IGET;ORDV08;OR_R18")
- +5 IF $DATA(@ROOT)
- Begin DoDot:1
- +6 NEW TMP
- SET TMP="Imaging ["_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-1826))_" TO "_$$FMTE^XLFDT(DT)_"]"
- SET $PIECE(TMP(1),"=",$LENGTH(TMP))="="
- +7 DO ADDTXT(TMP)
- DO ADDTXT(TMP(1))
- +8 NEW I,J
- SET I=0
- FOR
- SET I=$ORDER(@ROOT@(I))
- if '+I
- QUIT
- Begin DoDot:2
- +9 NEW OUT
- +10 SET OUT=$PIECE(@ROOT@(I,"WP",2),U,2)
- +11 SET OUT=$$SETSTR^VALM1($PIECE(@ROOT@(I,"WP",3),U,2),OUT,22,$LENGTH($PIECE(@ROOT@(I,"WP",3),U,2)))
- +12 SET OUT=$$SETSTR^VALM1($PIECE(@ROOT@(I,"WP",4),U,2),OUT,70,$LENGTH($PIECE(@ROOT@(I,"WP",4),U,2)))
- +13 DO ADDTXT(OUT)
- End DoDot:2
- End DoDot:1
- +14 IF '$DATA(@ROOT)
- DO ADDTXT("Imaging")
- DO ADDTXT("=======")
- DO ADDTXT("No imaging found.")
- +15 DO ADDTXT("")
- KILL @ROOT
- +16 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +17 SET @INF@(" Duration","Imaging [CPU]")=+$GET(@INF@(" Duration","Imaging [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +18 SET STOP=$HOROLOG
- +19 SET @INF@(" Duration","Imaging [SECS]")=+$GET(@INF@(" Duration","Imaging [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +20 QUIT
- FUTURE(DFN) ; future outpatient encounters
- +1 NEW CPUCLK,START,STOP
- SET START=$HOROLOG
- SET CPUCLK(1)=$$CPUTIME^XLFSHAN
- +2 DO ADDTXT("Future Appointments")
- DO ADDTXT("===================")
- +3 NEW DATA,VAERR,VAROOT,VDT
- SET VAROOT="Data"
- +4 DO SDA^VADPT
- +5 NEW I
- SET I=0
- FOR
- SET I=$ORDER(@VAROOT@(I))
- if '+I
- QUIT
- SET VDT=$PIECE(@VAROOT@(I,"I"),U)
- Begin DoDot:1
- +6 SET DATA(9999999-VDT)=VDT_U_$PIECE(@VAROOT@(I,"E"),U,2,3)
- End DoDot:1
- +7 SET VDT=0
- FOR
- SET VDT=$ORDER(DATA(VDT))
- if '+VDT
- QUIT
- Begin DoDot:1
- +8 SET DATA=$TRANSLATE($$FMTE^XLFDT(+DATA(VDT),"5MZ"),"@"," ")
- SET DATA=$$SETSTR^VALM1($PIECE(DATA(VDT),U,2),DATA,19,56)
- SET DATA=$$SETSTR^VALM1($PIECE(DATA(VDT),U,3),DATA,58,21)
- +9 DO ADDTXT(DATA)
- End DoDot:1
- +10 IF '$DATA(@VAROOT)
- DO ADDTXT("No future appointments found.")
- +11 DO ADDTXT("")
- +12 KILL @VAROOT
- +13 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
- +14 SET @INF@(" Duration","Future Visits [CPU]")=+$GET(@INF@(" Duration","Future Visits [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
- +15 SET STOP=$HOROLOG
- +16 SET @INF@(" Duration","Future Visits [SECS]")=+$GET(@INF@(" Duration","Future Visits [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
- +17 QUIT
- LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;
- +1 NEW DILOCKTM,DISYS
- +2 QUIT $$FIND1^DIC(FILE,$GET(IENS),$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"ERR")
- ADDTXT(DATA) ;
- +1 SET DOCTXT=DOCTXT+1
- +2 SET DOCTXT(DOCTXT,0)=DATA
- +3 QUIT
- WRAP(OUT,TEXT,LENGTH) ;
- +1 NEW TIUFI,TIUFJ,LINE,TIUFT1,TIUFT2,TIUFY
- +2 IF $GET(TEXT)']""
- QUIT
- +3 FOR TIUFI=1:1
- Begin DoDot:1
- +4 SET OUT=$PIECE(TEXT," ",TIUFI)
- +5 IF $LENGTH(OUT)>LENGTH
- Begin DoDot:2
- +6 SET TIUFT1=$EXTRACT(OUT,1,LENGTH)
- SET TIUFT2=$EXTRACT(OUT,LENGTH+1,$LENGTH(OUT))
- +7 SET $PIECE(TEXT," ",TIUFI)=TIUFT1_" "_TIUFT2
- End DoDot:2
- End DoDot:1
- if TIUFI=$LENGTH(TEXT," ")
- QUIT
- +8 SET LINE=1
- SET OUT(1)=$PIECE(TEXT," ")
- +9 FOR TIUFI=2:1
- Begin DoDot:1
- +10 if $LENGTH($GET(OUT(LINE))_" "_$PIECE(TEXT," ",TIUFI))>LENGTH
- SET LINE=LINE+1
- SET TIUFY=1
- +11 SET OUT(LINE)=$GET(OUT(LINE))_$SELECT(+$GET(TIUFY):"",1:" ")_$PIECE(TEXT," ",TIUFI)
- SET TIUFY=0
- End DoDot:1
- if TIUFI'<$LENGTH(TEXT," ")
- QUIT
- +12 QUIT