- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQ21.m
r613 r623 1 ORQ21 ; SLC/MKB/GSS - Detailed Order Report cont ; 12/28/2006 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,190,195,215,243**;Dec 17, 1997;Build 242 3 ; 4 ; DBIA 2400 OEL^PSOORRL ^TMP("PS",$J) 5 ; DBIA 2266 EN30^RAO7PC1 ^TMP($J,"RAE2") 6 ; 7 RAD(TCOM) ; -- add RA data for 2.5 orders 8 N RAIFN,CASE,PROC,ORD,ORI,X,ORTTL,ORB 9 S RAIFN=$G(^OR(100,ORIFN,4)) Q:RAIFN'>0 10 D EN30^RAO7PC1(RAIFN) Q:'$D(^TMP($J,"RAE2",+ORVP)) ;DBIA 2266 11 S ORD=$G(^TMP($J,"RAE2",+ORVP,"ORD")),CASE=$O(^(0)) Q:'CASE S PROC=$O(^(CASE,"")) 12 I '$G(TCOM) D ;else add only Tech Comments 13 . S CNT=CNT+1,@ORY@(CNT)=$$LJ^XLFSTR("Procedure:",30)_$S($L(ORD):ORD,1:PROC) 14 . S ORI=0,ORTTL="Procedure Modifiers: ",ORB=1 15 . F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"M",ORI)) Q:ORI'>0 S CNT=CNT+1,@ORY@(CNT)=ORTTL_^(ORI),ORTTL=$$REPEAT^XLFSTR(" ",30) 16 . S CNT=CNT+1,@ORY@(CNT)="History and Reason for Exam:" 17 . F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"H",ORI)) Q:ORI'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(ORI) 18 RAD1 I $L($G(^TMP($J,"RAE2",+ORVP,CASE,PROC,"TCOM",1))) S X=^(1) D 19 . N DIWL,DIWR,DIWF,I K ^UTILITY($J,"W") 20 . S DIWL=1,DIWR=72,DIWF="C72" D ^DIWP 21 . S CNT=CNT+1,@ORY@(CNT)="Technologist's Comment:",ORB=1 22 . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(I,0) 23 I $D(^TMP($J,"RAE2",+ORVP,CASE,PROC,"CM")) D 24 . S ORTTL="Contrast Media used: ",ORI=0,ORB=1 25 . F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"CM",ORI)) Q:ORI<1 S CNT=CNT+1,@ORY@(CNT)=ORTTL_$P(^(ORI),U,2),ORTTL=$$REPEAT^XLFSTR(" ",30) 26 K ^TMP($J,"RAE2",+ORVP),^UTILITY($J,"W") 27 S:$G(ORB) CNT=CNT+1,@ORY@(CNT)=" " ;blank 28 Q 29 ; 30 MED ; -- Add Pharmacy order data 31 Q:$G(^OR(100,ORIFN,4))["N" ;non-VA med -- no refill history 32 N TYPE,NODE,RXN,OR5,STAT S TYPE=$P(OR0,U,12) 33 I '$D(^TMP("PS",$J,0)) D ;get PS data / DBIA 2400 34 . N PSIFN S PSIFN=$G(^OR(100,ORIFN,4)) 35 . S:TYPE="O" PSIFN=$TR(PSIFN,"S","P")_$S(PSIFN?1.N:"R",1:"") 36 . D OEL^PSOORRL(+ORVP,PSIFN_";"_TYPE) ;DBIA 2400 37 S NODE=$G(^TMP("PS",$J,0)),RXN=$G(^("RXN",0)),STAT=$P(NODE,U,6) 38 I '$L(NODE) K ^TMP("PS",$J) Q ;error 39 I $O(^TMP("PS",$J,"DD",0)) D ;Disp Drugs 40 . N I,X,Y S X="Dispense Drugs (units/dose): ",I=0 41 . F S I=$O(^TMP("PS",$J,"DD",I)) Q:I'>0 S Y=$G(^(I,0)) S:Y CNT=CNT+1,@ORY@(CNT)=X_$$GET1^DIQ(50,+Y_",",.01)_" ("_$P(Y,U,2)_")" 42 S:$P(NODE,U,9) CNT=CNT+1,@ORY@(CNT)="Total Dose: "_$P(NODE,U,9) 43 M1 I TYPE="I" D ;admin data 44 . N I,X,Y I $O(^TMP("PS",$J,"B",0)) D 45 .. S X="IV Print Name: ",I=0 46 .. F S I=$O(^TMP("PS",$J,"B",I)) Q:I<1 S Y=$G(^(I,0)) S:$L(Y) CNT=CNT+1,@ORY@(CNT)=X_$P(Y,U),X=$$REPEAT^XLFSTR(" ",30) I $L($P(Y,U,3)) S CNT=CNT+1,@ORY@(CNT)=X_" "_$P(Y,U,3) 47 . S I=+$O(^TMP("PS",$J,"SCH",0)),X=$P($G(^(I,0)),U,2) 48 . S:$L(X) CNT=CNT+1,@ORY@(CNT)="Schedule Type: "_X 49 . S X="Administration Times: ",I=0 50 . F S I=$O(^TMP("PS",$J,"ADM",I)) Q:I'>0 S Y=$G(^(I,0)) S:$L(Y) CNT=CNT+1,@ORY@(CNT)=X_Y,X=$$REPEAT^XLFSTR(" ",30) 51 M2 I TYPE="O" D ;fill history 52 . N FILLD,RET,X,Y,I 53 . S:$P(NODE,U,12) CNT=CNT+1,@ORY@(CNT)="Last Filled: "_$$FMTE^XLFDT($P(NODE,U,12),2) 54 . S CNT=CNT+1,@ORY@(CNT)="Refills Remaining: "_$P(NODE,U,4) 55 . I $P(RXN,U,6)!$G(^TMP("PS",$J,"REF",0)) S X="Filled: " D 56 .. I $P(RXN,U,6) S FILLD=$P(RXN,U,6)_"^^^"_$P(RXN,U,7)_U_$P(RXN,U,3,4) D FILLED("R") 57 .. S RET=$G(^TMP("PS",$J,"RXN","RSTC")) I RET'="" D RETURNS(RET) 58 .. S I=0 F S I=$O(^TMP("PS",$J,"REF",I)) Q:I'>0 D 59 ... S FILLD=$G(^(I,0)) D FILLED("R") 60 ... S RET=$G(^TMP("PS",$J,"REF",I,"RSTC")) I RET'="" D RETURNS(RET) 61 . I $G(^TMP("PS",$J,"PAR",0)) S I=0,X="Partial Fills: " F S I=$O(^TMP("PS",$J,"PAR",I)) Q:I'>0 S FILLD=$G(^(I,0)) D FILLED("P") 62 . S:RXN CNT=CNT+1,@ORY@(CNT)="Prescription#: "_$P(RXN,U) 63 M3 S:$P(RXN,U,5) CNT=CNT+1,@ORY@(CNT)="Pharmacist: "_$P($G(^VA(200,+$P(RXN,U,5),0)),U) 64 I $G(STAT)="ACTIVE/SUSP" S CNT=CNT+1,@ORY@(CNT)="Prescription Status: "_STAT_" - Order is active. Fill or Refill has been requested." 65 S:$P(NODE,U,13) CNT=CNT+1,@ORY@(CNT)="NOT TO BE GIVEN" K ^TMP("PS",$J) 66 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 67 S OR5=$G(^OR(100,ORIFN,5)) I $L(OR5) D ;SC data 68 . N X,Y,I 69 . S CNT=CNT+1,@ORY@(CNT)=" " ;blank line 70 . S CNT=CNT+1,@ORY@(CNT)="First Party Pay Exemptions" 71 . S X="For conditions related to: " 72 . F I=1:1:8 S Y=$P(OR5,U,I) I Y S CNT=CNT+1,@ORY@(CNT)=X_$$SC(I),X=$$REPEAT^XLFSTR(" ",30) 73 Q 74 ; 75 BA ;Billing Aware data display 76 N DXIEN,DXV,ICD9,ICDR,OCT,ORFMDAT 77 S OCT=0,X="" 78 ; Get the date of the order for CSV/CTD usage 79 S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIFN) 80 ; $O through diagnoses for an order 81 F S OCT=$O(^OR(100,ORIFN,5.1,OCT)) Q:OCT'?1N.N D 82 . ; DXIEN=Dx IEN 83 . S DXIEN=+^OR(100,ORIFN,5.1,OCT,0) 84 . ; Get Dx record for date ORFMDAT 85 . S ICDR=$$ICDDX^ICDCODE(DXIEN,ORFMDAT) 86 . ; Get Dx verbiage and ICD code 87 . S DXV=$P(ICDR,U,4),ICD9=$P(ICDR,U,2) 88 . S X=" " 89 . I OCT=1 D 90 .. S CNT=CNT+1,@ORY@(CNT)=" " ;blank line 91 .. S CNT=CNT+1,@ORY@(CNT)="Clinical Indicators" 92 .. S X="Diagnosis of: " 93 . S X=X_ICD9_" - "_DXV,CNT=CNT+1,@ORY@(CNT)=X 94 I OCT'="" D ;if there are diagnoses show Treatment Factors 95 . S X="For conditions related to: " 96 . F I=1:1:8 S Y=$P(^OR(100,ORIFN,5.2),U,I) I Y D 97 .. S CNT=CNT+1,@ORY@(CNT)=X_$$SC(I),X=$$REPEAT^XLFSTR(" ",30) 98 Q 99 ; 100 FILLED(TYPE) ; -- add FILLD data 101 N Y S Y=$$FMTE^XLFDT($P(FILLD,U),2)_" ("_$$ROUTING($P(FILLD,U,5))_")" 102 S:TYPE="R"&$P(FILLD,U,4) Y=Y_" released "_$$FMTE^XLFDT($P(FILLD,U,4),2) 103 S:TYPE="P"&$P(FILLD,U,3) Y=Y_" Qty: "_$P(FILLD,U,3) 104 S CNT=CNT+1,@ORY@(CNT)=X_Y,X=$$REPEAT^XLFSTR(" ",30) 105 S:$L($P(FILLD,U,6)) CNT=CNT+1,@ORY@(CNT)=X_$P(FILLD,U,6) 106 Q 107 RETURNS(NODE) ; add Return to Stock Data 108 N DATE,NAME,TEXT,X 109 S DATE=$$FMTE^XLFDT($P(NODE,U)) 110 S NAME=$P(^VA(200,$P(NODE,U,2),0),U) 111 S X=$$REPEAT^XLFSTR(" ",13) 112 S TEXT="Return to Stock: "_X_DATE_" by "_NAME 113 S CNT=CNT+1,@ORY@(CNT)=TEXT 114 S X=$$REPEAT^XLFSTR(" ",30) 115 S TEXT=X_"Comments: "_$P(NODE,U,3) 116 S CNT=CNT+1,@ORY@(CNT)=TEXT 117 Q 118 ; 119 ROUTING(X) ; -- Returns external form 120 N Y S Y=$S($G(X)="M":"Mail",$G(X)="W":"Window",1:$G(X)) 121 Q Y 122 ; 123 SC(J) ; -- Returns name of SC field by piece number 124 I '$G(J) Q "" 125 I J=1 Q "SERVICE CONNECTED CONDITION" 126 I J=2 Q "MILITARY SEXUAL TRAUMA" 127 I J=3 Q "AGENT ORANGE EXPOSURE" 128 I J=4 Q "IONIZING RADIATION EXPOSURE" 129 I J=5 Q "ENVIRONMENTAL CONTAMINANTS" 130 I J=6 Q "HEAD OR NECK CANCER" 131 I J=7 Q "COMBAT VETERAN" 132 I J=8 Q "SHIPBOARD HAZARD AND DEFENSE" 133 Q "" 1 ORQ21 ; SLC/MKB/GSS - Detailed Order Report cont ; 10/6/2005 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,190,195,215**;Dec 17, 1997 3 ; 4 ; DBIA 2400 OEL^PSOORRL ^TMP("PS",$J) 5 ; DBIA 2266 EN30^RAO7PC1 ^TMP($J,"RAE2") 6 ; 7 RAD(TCOM) ; -- add RA data for 2.5 orders 8 N RAIFN,CASE,PROC,ORD,ORI,X,ORTTL,ORB 9 S RAIFN=$G(^OR(100,ORIFN,4)) Q:RAIFN'>0 10 D EN30^RAO7PC1(RAIFN) Q:'$D(^TMP($J,"RAE2",+ORVP)) ;DBIA 2266 11 S ORD=$G(^TMP($J,"RAE2",+ORVP,"ORD")),CASE=$O(^(0)) Q:'CASE S PROC=$O(^(CASE,"")) 12 I '$G(TCOM) D ;else add only Tech Comments 13 . S CNT=CNT+1,@ORY@(CNT)=$$LJ^XLFSTR("Procedure:",30)_$S($L(ORD):ORD,1:PROC) 14 . S ORI=0,ORTTL="Procedure Modifiers: ",ORB=1 15 . F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"M",ORI)) Q:ORI'>0 S CNT=CNT+1,@ORY@(CNT)=ORTTL_^(ORI),ORTTL=$$REPEAT^XLFSTR(" ",30) 16 . S CNT=CNT+1,@ORY@(CNT)="History and Reason for Exam:" 17 . F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"H",ORI)) Q:ORI'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(ORI) 18 RAD1 I $L($G(^TMP($J,"RAE2",+ORVP,CASE,PROC,"TCOM",1))) S X=^(1) D 19 . N DIWL,DIWR,DIWF,I K ^UTILITY($J,"W") 20 . S DIWL=1,DIWR=72,DIWF="C72" D ^DIWP 21 . S CNT=CNT+1,@ORY@(CNT)="Technologist's Comment:",ORB=1 22 . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(I,0) 23 I $D(^TMP($J,"RAE2",+ORVP,CASE,PROC,"CM")) D 24 . S ORTTL="Contrast Media used: ",ORI=0,ORB=1 25 . F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"CM",ORI)) Q:ORI<1 S CNT=CNT+1,@ORY@(CNT)=ORTTL_$P(^(ORI),U,2),ORTTL=$$REPEAT^XLFSTR(" ",30) 26 K ^TMP($J,"RAE2",+ORVP),^UTILITY($J,"W") 27 S:$G(ORB) CNT=CNT+1,@ORY@(CNT)=" " ;blank 28 Q 29 ; 30 MED ; -- Add Pharmacy order data 31 Q:$G(^OR(100,ORIFN,4))["N" ;non-VA med -- no refill history 32 N TYPE,NODE,RXN,OR5,STAT S TYPE=$P(OR0,U,12) 33 I '$D(^TMP("PS",$J,0)) D ;get PS data / DBIA 2400 34 . N PSIFN S PSIFN=$G(^OR(100,ORIFN,4)) 35 . S:TYPE="O" PSIFN=$TR(PSIFN,"S","P")_$S(PSIFN?1.N:"R",1:"") 36 . D OEL^PSOORRL(+ORVP,PSIFN_";"_TYPE) ;DBIA 2400 37 S NODE=$G(^TMP("PS",$J,0)),RXN=$G(^("RXN",0)),STAT=$P(NODE,U,6) 38 I '$L(NODE) K ^TMP("PS",$J) Q ;error 39 I $O(^TMP("PS",$J,"DD",0)) D ;Disp Drugs 40 . N I,X,Y S X="Dispense Drugs (units/dose): ",I=0 41 . F S I=$O(^TMP("PS",$J,"DD",I)) Q:I'>0 S Y=$G(^(I,0)) S:Y CNT=CNT+1,@ORY@(CNT)=X_$$GET1^DIQ(50,+Y_",",.01)_" ("_$P(Y,U,2)_")" 42 S:$P(NODE,U,9) CNT=CNT+1,@ORY@(CNT)="Total Dose: "_$P(NODE,U,9) 43 M1 I TYPE="I" D ;admin data 44 . N I,X,Y I $O(^TMP("PS",$J,"B",0)) D 45 .. S X="IV Print Name: ",I=0 46 .. F S I=$O(^TMP("PS",$J,"B",I)) Q:I<1 S Y=$G(^(I,0)) S:$L(Y) CNT=CNT+1,@ORY@(CNT)=X_$P(Y,U),X=$$REPEAT^XLFSTR(" ",30) I $L($P(Y,U,3)) S CNT=CNT+1,@ORY@(CNT)=X_" "_$P(Y,U,3) 47 . S I=+$O(^TMP("PS",$J,"SCH",0)),X=$P($G(^(I,0)),U,2) 48 . S:$L(X) CNT=CNT+1,@ORY@(CNT)="Schedule Type: "_X 49 . S X="Administration Times: ",I=0 50 . F S I=$O(^TMP("PS",$J,"ADM",I)) Q:I'>0 S Y=$G(^(I,0)) S:$L(Y) CNT=CNT+1,@ORY@(CNT)=X_Y,X=$$REPEAT^XLFSTR(" ",30) 51 M2 I TYPE="O" D ;fill history 52 . N FILLD,X,Y,I 53 . S:$P(NODE,U,12) CNT=CNT+1,@ORY@(CNT)="Last Filled: "_$$FMTE^XLFDT($P(NODE,U,12),2) 54 . S CNT=CNT+1,@ORY@(CNT)="Refills Remaining: "_$P(NODE,U,4) 55 . I $P(RXN,U,6)!$G(^TMP("PS",$J,"REF",0)) S X="Filled: " D 56 .. I $P(RXN,U,6) S FILLD=$P(RXN,U,6)_"^^^"_$P(RXN,U,7)_U_$P(RXN,U,3,4) D FILLED("R") 57 .. S I=0 F S I=$O(^TMP("PS",$J,"REF",I)) Q:I'>0 S FILLD=$G(^(I,0)) D FILLED("R") 58 . I $G(^TMP("PS",$J,"PAR",0)) S I=0,X="Partial Fills: " F S I=$O(^TMP("PS",$J,"PAR",I)) Q:I'>0 S FILLD=$G(^(I,0)) D FILLED("P") 59 . S:RXN CNT=CNT+1,@ORY@(CNT)="Prescription#: "_$P(RXN,U) 60 M3 S:$P(RXN,U,5) CNT=CNT+1,@ORY@(CNT)="Pharmacist: "_$P($G(^VA(200,+$P(RXN,U,5),0)),U) 61 I $G(STAT)="ACTIVE/SUSP" S CNT=CNT+1,@ORY@(CNT)="Prescription Status: "_STAT_" - Order is active. Fill or Refill has been requested." 62 S:$P(NODE,U,13) CNT=CNT+1,@ORY@(CNT)="NOT TO BE GIVEN" K ^TMP("PS",$J) 63 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 64 S OR5=$G(^OR(100,ORIFN,5)) I $L(OR5) D ;SC data 65 . N X,Y,I 66 . S CNT=CNT+1,@ORY@(CNT)=" " ;blank line 67 . S CNT=CNT+1,@ORY@(CNT)="First Party Pay Exemptions" 68 . S X="For conditions related to: " 69 . F I=1:1:7 S Y=$P(OR5,U,I) I Y S CNT=CNT+1,@ORY@(CNT)=X_$$SC(I),X=$$REPEAT^XLFSTR(" ",30) 70 Q 71 ; 72 BA ;Billing Aware data display 73 N DXIEN,DXV,ICD9,ICDR,OCT,ORFMDAT 74 S OCT=0,X="" 75 ; Get the date of the order for CSV/CTD usage 76 S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIFN) 77 ; $O through diagnoses for an order 78 F S OCT=$O(^OR(100,ORIFN,5.1,OCT)) Q:OCT'?1N.N D 79 . ; DXIEN=Dx IEN 80 . S DXIEN=+^OR(100,ORIFN,5.1,OCT,0) 81 . ; Get Dx record for date ORFMDAT 82 . S ICDR=$$ICDDX^ICDCODE(DXIEN,ORFMDAT) 83 . ; Get Dx verbiage and ICD code 84 . S DXV=$P(ICDR,U,4),ICD9=$P(ICDR,U,2) 85 . S X=" " 86 . I OCT=1 D 87 .. S CNT=CNT+1,@ORY@(CNT)=" " ;blank line 88 .. S CNT=CNT+1,@ORY@(CNT)="Clinical Indicators" 89 .. S X="Diagnosis of: " 90 . S X=X_ICD9_" - "_DXV,CNT=CNT+1,@ORY@(CNT)=X 91 I OCT'="" D ;if there are diagnoses show Treatment Factors 92 . S X="For conditions related to: " 93 . F I=1:1:7 S Y=$P(^OR(100,ORIFN,5.2),U,I) I Y D 94 .. S CNT=CNT+1,@ORY@(CNT)=X_$$SC(I),X=$$REPEAT^XLFSTR(" ",30) 95 Q 96 ; 97 FILLED(TYPE) ; -- add FILLD data 98 N Y S Y=$$FMTE^XLFDT($P(FILLD,U),2)_" ("_$$ROUTING($P(FILLD,U,5))_")" 99 S:TYPE="R"&$P(FILLD,U,4) Y=Y_" released "_$$FMTE^XLFDT($P(FILLD,U,4),2) 100 S:TYPE="P"&$P(FILLD,U,3) Y=Y_" Qty: "_$P(FILLD,U,3) 101 S CNT=CNT+1,@ORY@(CNT)=X_Y,X=$$REPEAT^XLFSTR(" ",30) 102 S:$L($P(FILLD,U,6)) CNT=CNT+1,@ORY@(CNT)=X_$P(FILLD,U,6) 103 Q 104 ; 105 ROUTING(X) ; -- Returns external form 106 N Y S Y=$S($G(X)="M":"Mail",$G(X)="W":"Window",1:$G(X)) 107 Q Y 108 ; 109 SC(J) ; -- Returns name of SC field by piece number 110 I '$G(J) Q "" 111 I J=1 Q "SERVICE CONNECTED CONDITION" 112 I J=2 Q "MILITARY SEXUAL TRAUMA" 113 I J=3 Q "AGENT ORANGE EXPOSURE" 114 I J=4 Q "IONIZING RADIATION EXPOSURE" 115 I J=5 Q "ENVIRONMENTAL CONTAMINANTS" 116 I J=6 Q "HEAD OR NECK CANCER" 117 I J=7 Q "COMBAT VETERAN" 118 Q ""
Note:
See TracChangeset
for help on using the changeset viewer.
