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

ORCHTAB2.m

Go to the documentation of this file.
  1. ORCHTAB2 ;SLC/MKB/REV-Add item to tab listing cont ;03/18/11 12:02
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,58,181,306**;Dec 17, 1997;Build 43
  1. GMRA ; -- allergies
  1. N ORY,ORI,ALLG,SEV,ID,SIGNS,J,ORIFN,DATA,X,ORTX
  1. D SUBHDR^ORCHTAB("Allergies/Adverse Reactions")
  1. D EN1^GMRAOR1(+ORVP,"ORY")
  1. I '$G(ORY) S X=$S($G(ORY)="":"No assessment available",1:"No known allergies") D LINE^ORCHTAB Q
  1. S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D
  1. . S ALLG=$P(ORY(ORI),U),SEV=$P(ORY(ORI),U,2),ID=$P(ORY(ORI),U,3)
  1. . S X=$S($L(SEV):$$LOWER^VALM1(SEV)_" reaction to ",1:"")_ALLG
  1. . S SIGNS="",J=0 F S J=$O(ORY(ORI,"S",J)) Q:J'>0 S SIGNS=SIGNS_$S($L(SIGNS):", ",1:"")_$$LOW^XLFSTR(ORY(ORI,"S",J))
  1. . S:$L(SIGNS) X=X_" ("_SIGNS_")"
  1. . S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
  1. . S DATA(1)=$$DATE^ORCHTAB($P(^GMR(120.8,ID,0),U,4)),DATA=1,ORIFN="GMRA"
  1. . D ADD^ORCHTAB
  1. Q
  1. ;
  1. GMRV ; -- Vitals
  1. N ORY,ORI,X,Y,DATA
  1. D SUBHDR^ORCHTAB("Recent Vitals"),FASTVIT^ORQQVI(.ORY,+ORVP)
  1. I '$O(ORY(0)) S X="No data available" D LINE^ORCHTAB Q
  1. S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D
  1. . S Y=$P(ORY(ORI),U,5)_" "_$P(ORY(ORI),U,6) S:$L(Y)'>1 Y=$P(ORY(ORI),U,3)
  1. . S X=$P(ORY(ORI),U,2),X=$S(X="BP":"B/P: ",X="HT":"Ht: ",X="P":"Pulse: ",X="R":"Resp: ",X="T":"Temp: ",X="WT":"Wt: ",X="PN":"Pain: ",1:$$LJ^XLFSTR(X_":",7))_Y
  1. . S DATA=$$DATETIME^ORCHTAB($P(ORY(ORI),U,4))
  1. . D LINE^ORCHTAB
  1. Q
  1. ;
  1. IMM ; -- Immunizations
  1. N ORIMM,ORIDT,ORI,X,Y,DATA K ^TMP("PXI",$J)
  1. D SUBHDR^ORCHTAB("Recent Immunizations"),IMMUN^PXRHS03(+ORVP)
  1. S ORIMM=0 F S ORIMM=$O(^TMP("PXI",$J,ORIMM)) Q:ORIMM="" D
  1. . S ORIDT=$O(^TMP("PXI",$J,ORIMM,0)),ORI=$O(^(ORIDT,0)),Y=$G(^(ORI,0))
  1. . S X=ORIMM_$S($L($P(Y,U,6)):" ("_$P(Y,U,6)_")",1:"")
  1. . S DATA=$S('ORI:"",1:$$DATETIME^ORCHTAB($P(Y,U,3)))
  1. . D LINE^ORCHTAB
  1. Q
  1. ;
  1. SC ; -- Service Connected data
  1. N DFN,VAEL,VASV,VAERR,X,DATA
  1. S DFN=+ORVP D 7^VADPT,SUBHDR^ORCHTAB("Eligibility")
  1. I VAEL(3) S X="Service Connected "_$P(VAEL(3),U,2)_"%"
  1. E S X="Not Service Connected"
  1. D LINE^ORCHTAB
  1. I VASV(2) S X="Agent Orange Exposure" D LINE^ORCHTAB
  1. I VASV(3) S X="Radiation Exposure" D LINE^ORCHTAB
  1. I $P($G(^DPT(+ORVP,.322)),U,10) S X="Environmental Contaminants exposure" D LINE^ORCHTAB
  1. Q
  1. ;
  1. CWAD ; -- postings
  1. N ORI,ORX,MSG,CNT,X,ID,DATA,ORIFN,ORTX K ^TMP("TIUPPCV",$J)
  1. D SUBHDR^ORCHTAB("Patient Postings")
  1. D ENCOVER^TIUPP3(+ORVP)
  1. S CNT=0,ORIFN="TIU"
  1. S ORI=0 F S ORI=$O(^TMP("TIUPPCV",$J,ORI)) Q:ORI'>0 S ORX=$G(^(ORI)) D
  1. . S ID=$P(ORX,U) Q:'$L(ID)
  1. . S X=$P(ORX,U,3),DATA(1)=$$DATETIME^ORCHTAB($P(ORX,U,5)),DATA=1
  1. . S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
  1. . D ADD^ORCHTAB S CNT=CNT+1
  1. I 'CNT S LCNT=LCNT+1,^TMP("OR",$J,ORTAB,LCNT,0)=" "_$$PAD^ORCHTAB("<None>",40)_"|"
  1. K ^TMP("TIUPPCV",$J)
  1. Q
  1. ;
  1. PROB ; -- problem
  1. N ID,DATA,X,ORTX,FIRST,ORJ,ORIFN
  1. S ID=$P(ORX,U),ORIFN=$P(ORX,U,2) ;problem ptr, status
  1. S X=$P(ORX,U,3)
  1. S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
  1. S DATA(1)=$$PAD^ORCHTAB($$DATE^ORCHTAB($P(ORX,U,5)),10)_$$PAD^ORCHTAB($$DATE^ORCHTAB($P(ORX,U,6)),10)_$S($P(ORX,U,2)="I":"inactive",1:"active "_$P(ORX,U,9)),DATA=1
  1. I COMM,$O(ORY(ORI,0)) S ORJ=0 F S ORJ=$O(ORY(ORI,ORJ)) Q:ORJ'>0 S X=" "_ORY(ORI,ORJ) I $L(X)>1 S ORTX=ORTX+1,ORTX(ORTX)="" D TXT^ORCHTAB ;add comments
  1. S FIRST=LCNT+1 D ADD^ORCHTAB
  1. I $L($P(ORX,U,10)) S $E(^TMP("OR",$J,ORTAB,FIRST,0),5)=$P(ORX,U,10) ; unverified flag ($)
  1. ; CSV change - check for active code, for active problem list only
  1. ; Inactive code flag (#) takes precedence and replaces unverified flag ($)
  1. I $P(ORX,U,2)="A",'$$CODESTS^GMPLX(ID,DT) S $E(^TMP("OR",$J,ORTAB,FIRST,0),5)="#"
  1. Q
  1. ;
  1. NOTE ; -- progress note
  1. N ID,DATA,X,ORTX
  1. S DATA(1)=$$PAD^ORCHTAB($$DATETIME^ORCHTAB($P(ORX,U,3)),16)_$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(+$P(ORX,U,5)),12)_$E($P(ORX,U,7),1,5),DATA=1
  1. S ID=$P(ORX,U),X=$P(ORX,U,2)
  1. S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
  1. I SUBJ,$L($P(ORX,U,12)) S X=" "_$P(ORX,U,12),ORTX=ORTX+1,ORTX(ORTX)="" D TXT^ORCHTAB ;add note subject
  1. D ADD^ORCHTAB
  1. Q
  1. ;
  1. SUMM ; -- discharge summary
  1. N ID,DATA,ORTX
  1. S DATA(1)=$$DATE^ORCHTAB($P(ORX,U,3))_" "_$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(+$P(ORX,U,5)),15)_$E($P(ORX,U,7),1,5)_$P($P(ORX,U,8)," ",2)_" "_$P($P(ORX,U,9)," ",2)
  1. S ID=$P(ORX,U),ORTX=1,ORTX(1)=$P(ORX,U,2),DATA=1
  1. D ADD^ORCHTAB
  1. Q
  1. ;
  1. INITIALS(USER) ; -- Return initials of USER
  1. N X,Y S X=$G(^VA(200,+$G(USER),0)),Y=$P(X,U,2)
  1. S:'$L(Y) Y=" x "
  1. Q Y