- 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/ORCSAVE1.m
r613 r623 1 ORCSAVE1 ; SLC/MKB - Save Order Text ;02/22/07 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,132,141,163,187,223,243**;Dec 17, 1997;Build 242 3 ; 4 ; ^ORD(101.41,+ORDIALOG,10,ITM,2)=Seq#^Format^Omit^Lead Text^Trail Text 5 ; ^ORD(101.41,+ORDIALOG,10,"ATXT",Seq#,ITM)="" 6 ; 7 ORDTEXT(ORDER) ; -- Build and save order text from ORDIALOG() into ORDER 8 N ORTX,I,IFN,ACT,ORSET 9 D ORTX(240) Q:'$G(ORTX) 10 S IFN=+ORDER,ACT=+$P(ORDER,";",2) S:ACT'>0 ACT=1 11 F I=1:1:ORTX S ^OR(100,IFN,8,ACT,.1,I,0)=ORTX(I) 12 S ^OR(100,IFN,8,ACT,.1,0)=U_U_ORTX_U_ORTX_U_DT_U 13 I $E($G(ORDEA))=2 D ;PKI Drug Schedule - in future may allow 2-5 14 . S ORSET=0 15 . D DIGTEXT(IFN,ORDEA) 16 . F I=1:1:ORSET S ^OR(100,IFN,8,ACT,.2,I,0)=ORSET(I) 17 . I ORSET>0 S ^OR(100,IFN,8,ACT,.2,0)=U_U_ORSET_U_ORSET_U_DT_U 18 Q 19 ; 20 ORTX(WIDTH) ; -- May enter here to return order text in ORTX() 21 N ORP,SEQ,ITEM,ORMAX,IVIEN,IVITEM,IVTYPE,RATE 22 K ORTX S ORMAX=$S(+$G(WIDTH):WIDTH,1:240) 23 D EXT ; get external form of values 24 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"ATXT",SEQ)) Q:SEQ'>0 D 25 . S ITEM=0 F S ITEM=$O(^ORD(101.41,+ORDIALOG,10,"ATXT",SEQ,ITEM)) Q:ITEM'>0 D TEXT(ITEM) 26 Q 27 ; 28 TEXT(DA) ; -- Includes text of item DA 29 Q:$P(^ORD(101.41,ORDIALOG,10,DA,0),U,11) Q:'$O(ORP(DA,0)) 30 N NEWLN,INST,TYPE,PTR,CHSEQ,CHILD,ORI,X,Y 31 S:'$G(ORTX) ORTX=1,ORTX(1)="" 32 S NEWLN=+$P(ORP(DA),U,4),INST=$O(ORP(DA,0)),Y="" 33 I NEWLN,$L(ORTX(ORTX)) S ORTX=ORTX+1,ORTX(ORTX)="",Y=" " 34 S X=$$GETXT($P(ORP(DA),U,2)) I $L(X) S X=Y_X,Y="" D TXT^ORCHTAB ;lead tx 35 S PTR=+ORP(DA),TYPE=$E(ORDIALOG(PTR,0)) 36 TXT1 I TYPE'="W" S X=Y_ORP(DA,INST),Y="" D TXT^ORCHTAB 37 I TYPE="W" S ORI=0 F S ORI=$O(ORP(DA,INST,ORI)) Q:ORI'>0 D S Y="" 38 . S Y=$S(Y=" ":" ",$P(ORP(DA),U,5):" ",1:"") ;new line, or as stored 39 . S X=Y_ORP(DA,INST,ORI,0),Y="" 40 . I $E(X)'=" " D TXT^ORCHTAB Q ; wrap 41 . S:$L(ORTX(ORTX)) ORTX=ORTX+1,ORTX(ORTX)="" ; force new line 42 . I X?1." " S ORTX(ORTX)=" ",ORTX=ORTX+1,ORTX(ORTX)="" ; blank line 43 . E D TXT^ORCHTAB 44 D:$D(^ORD(101.41,+ORDIALOG,10,"DAD",PTR)) CHILD(PTR) 45 S INST=$O(ORP(DA,INST)) ; multiple? 46 I INST S ORTX(ORTX)=ORTX(ORTX)_",",Y="" S:NEWLN ORTX=ORTX+1,ORTX(ORTX)="",Y=" " G TXT1 47 S X=$$GETXT($P(ORP(DA),U,3)) D:$L(X) TXT^ORCHTAB ; trailing text 48 Q 49 ; 50 CHILD(PARENT) ; -- add child values 51 N CHSEQ,CHILD S CHSEQ=0 52 F S CHSEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,CHSEQ)) Q:CHSEQ'>0 S CHILD=$O(^(CHSEQ,0)) D 53 . Q:'$L($G(ORP(CHILD,INST))) 54 . S X=$$GETXT($P(ORP(CHILD),U,2)) D:$L(X) TXT^ORCHTAB ; lead text 55 . S X=ORP(CHILD,INST) D TXT^ORCHTAB 56 . S X=$$GETXT($P(ORP(CHILD),U,3)) D:$L(X) TXT^ORCHTAB ; trail text 57 Q 58 ; 59 GETXT(X) ; -- Returns text of X 60 I $E(X)="@" N VAR S VAR=$E(X,2,99),X=$G(@VAR) K @VAR ; variable w/text 61 Q X 62 ; 63 EXT ; -- Build ORP(DA) array of external forms 64 N PROMPT,INST,DA,NODE,FORMAT,OMIT,X,Y,TYPE,PTR 65 S PROMPT=0 F S PROMPT=$O(ORDIALOG(PROMPT)) Q:PROMPT'>0 D 66 . S DA=+$G(ORDIALOG(PROMPT)),TYPE=$E($G(ORDIALOG(PROMPT,0))) Q:'$L(TYPE) 67 . Q:'DA S NODE=$G(^ORD(101.41,ORDIALOG,10,DA,2)),FORMAT=$P(NODE,U,2),OMIT=$P(NODE,U,3) 68 . S:$D(ORDIALOG(PROMPT,"FORMAT")) FORMAT=ORDIALOG(PROMPT,"FORMAT") 69 . I $E(FORMAT)="@" S PTR=+$E(FORMAT,2,99) Q:'PTR ; Don't include 70 . S INST=0 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0 D 71 . . Q:ORDIALOG(PROMPT,INST)="" 72 . . I $E(FORMAT)="@",$L($G(ORDIALOG(PTR,INST))) Q ; use PTR instead 73 . . I $E(FORMAT)="*" S PTR=+$E(FORMAT,2,99) I '$L($G(ORDIALOG(PTR,INST))) Q ; must have PTR too 74 . . I $E(FORMAT)="=" S PTR=+$E(FORMAT,2,99) I PTR,$L($G(ORDIALOG(PTR,INST))) S Y=$$EXT^ORCD(PTR,INST),X=$$EXT^ORCD(PROMPT,INST) I (X=Y)!(X[Y)!(Y[X) Q 75 . . I TYPE="W" M ORP(DA,INST)=@ORDIALOG(PROMPT,INST) 76 . . E S X=$$EXT^ORCD(PROMPT,INST,FORMAT) Q:X="" Q:OMIT[X S ORP(DA,INST)=X 77 . . S ORP(DA)=PROMPT_U_$P(NODE,U,4,7) ; ptr^lead^trail^new line^wrap 78 Q 79 DIGTEXT(ORDER,ORDEA,ORSIGNER) ;Build text used to create Digital Signature 80 ;ORDER = ifn of order # (file 100) 81 ;ORDEA = Controlled substance schedule of drug (2-5) 82 ;ORSIGNER = DUZ of sigining physician 83 ;ORSET(1)=1)Date of Prescription (RX) -Date Ordered HL7 format 2)Full Patient Name 3)Patient SSN 4)DFN 84 ;ORSET(2)=5)Patient Street1 6)Patient Street2 7)Patient Street3 8)Patient City 9)Patient State 10)Patient Zip 11)??? 85 ;ORSET(3)=12)Drug name (From Dispense Drug or Orderable Item) 13)Variable ptr for Drug (file 50 or 101.43) 14)Drug quantity prescribed 15)Schedule of medication 16)DEA Schedule 86 ;ORSET(4)=17)Direction for use 87 ;ORSET(5)=18)Practitioner's name 19)DUZ 20)Practitioner's (DEA) registration number 88 ;ORSET(6)=22)SiteName 23)SiteStreet1 24)SiteStreet2 25)SiteCity 26)SiteState 27)SiteZip 89 ;ORSET(7)=28)$H 90 N I,DFN,OR80,ORPNM,ORSSN,ORXDT,VAERR,VAPA,X0,X1,X4,X5,X6,X8,X9,X10,X11,X12,X13,X14,SIG 91 S OR80=$G(^OR(100,ORDER,8,1,0)) 92 Q:'$L(OR80) 93 S:'$G(ORSIGNER) ORSIGNER=$P(OR80,"^",3) 94 Q:'ORSIGNER 95 S $P(^OR(100,ORDER,8,1,2),"^",4,5)=ORDEA_"^"_1 ;Flag to signing process to get digital signature 96 S ORXDT=$P(OR80,"^"),X1=$$FMTHL7^XLFDT(ORXDT),X4="",X14="",X10="" 97 I '$D(ORVP) S ORVP=$P(^OR(100,ORDER,0),"^",2) 98 S DFN=+ORVP 99 D ADD^VADPT 100 S ORPNM=^DPT(+ORVP,0),ORSSN=$P(ORPNM,"^",9),ORPNM=$P(ORPNM,"^") 101 F I=1:1:6 S X4=X4_$S($L($G(VAPA(I))):$S((I=5):$P(VAPA(I),"^",2),1:VAPA(I)),1:"")_"^" 102 S X11=$$GET1^DIQ(200,ORSIGNER,.01,"E") Q:'$L(X11) 103 S X12=$$DEA^XUSER(,ORSIGNER) 104 S X0=$$GET1^DIQ(4,+$G(DUZ(2)),.01,"E") 105 I $L(X0) S X14=X0_"^"_$$GET1^DIQ(4,DUZ(2),1.01,"E")_"^"_$$GET1^DIQ(4,DUZ(2),1.02,"E")_"^"_$$GET1^DIQ(4,DUZ(2),1.03,"E")_"^"_$$GET1^DIQ(4,DUZ(2),.02,"E")_"^"_$$GET1^DIQ(4,DUZ(2),1.04,"E") 106 S X5=$$VALUE^ORX8(ORDER,"DRUG",,"E"),X6=$$VALUE^ORX8(ORDER,"DRUG")_";50" 107 I '$L(X5) S X5=$$VALUE^ORX8(ORDER,"ORDERABLE",,"E"),X6=$$VALUE^ORX8(ORDER,"ORDERABLE")_";101.43" 108 S X8=$$VALUE^ORX8(ORDER,"QTY",,"E"),X9=$$VALUE^ORX8(ORDER,"SCHEDULE",,"E") 109 S SIG=+$O(^OR(100,ORDER,4.5,"ID","SIG",0)) I SIG,$L($G(^OR(100,ORDER,4.5,SIG,2,1,0))) S X10=^(0) 110 S ORSET(1)=X1_"^"_ORPNM_"^"_ORSSN_"^"_+ORVP_"^" 111 S ORSET(2)=X4_"^" 112 S ORSET(3)=X5_"^"_X6_"^"_X8_"^"_X9_"^"_ORDEA_"^" 113 S ORSET(4)=X10_"^" 114 S ORSET(5)=X11_"^"_ORSIGNER_"^"_X12_"^" 115 S ORSET(6)=X14 116 S ORSET(7)=$H 117 S ORSET=7 118 Q 1 ORCSAVE1 ; SLC/MKB - Save Order Text ;7/13/04 15:41 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,132,141,163,187,223**;Dec 17, 1997 3 ; 4 ; ^ORD(101.41,+ORDIALOG,10,ITM,2)=Seq#^Format^Omit^Lead Text^Trail Text 5 ; ^ORD(101.41,+ORDIALOG,10,"ATXT",Seq#,ITM)="" 6 ; 7 ORDTEXT(ORDER) ; -- Build and save order text from ORDIALOG() into ORDER 8 N ORTX,I,IFN,ACT,ORSET 9 D ORTX(240) Q:'$G(ORTX) 10 S IFN=+ORDER,ACT=+$P(ORDER,";",2) S:ACT'>0 ACT=1 11 F I=1:1:ORTX S ^OR(100,IFN,8,ACT,.1,I,0)=ORTX(I) 12 S ^OR(100,IFN,8,ACT,.1,0)=U_U_ORTX_U_ORTX_U_DT_U 13 I $E($G(ORDEA))=2 D ;PKI Drug Schedule - in future may allow 2-5 14 . S ORSET=0 15 . D DIGTEXT(IFN,ORDEA) 16 . F I=1:1:ORSET S ^OR(100,IFN,8,ACT,.2,I,0)=ORSET(I) 17 . I ORSET>0 S ^OR(100,IFN,8,ACT,.2,0)=U_U_ORSET_U_ORSET_U_DT_U 18 Q 19 ; 20 ORTX(WIDTH) ; -- May enter here to return order text in ORTX() 21 N ORP,SEQ,ITEM,ORMAX 22 K ORTX S ORMAX=$S(+$G(WIDTH):WIDTH,1:240) 23 D EXT ; get external form of values 24 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"ATXT",SEQ)) Q:SEQ'>0 S ITEM=$O(^(SEQ,0)) D TEXT(ITEM) 25 Q 26 ; 27 TEXT(DA) ; -- Includes text of item DA 28 Q:$P(^ORD(101.41,ORDIALOG,10,DA,0),U,11) Q:'$O(ORP(DA,0)) 29 N NEWLN,INST,TYPE,PTR,CHSEQ,CHILD,ORI,X,Y 30 S:'$G(ORTX) ORTX=1,ORTX(1)="" 31 S NEWLN=+$P(ORP(DA),U,4),INST=$O(ORP(DA,0)),Y="" 32 I NEWLN,$L(ORTX(ORTX)) S ORTX=ORTX+1,ORTX(ORTX)="",Y=" " 33 S X=$$GETXT($P(ORP(DA),U,2)) I $L(X) S X=Y_X,Y="" D TXT^ORCHTAB ;lead tx 34 S PTR=+ORP(DA),TYPE=$E(ORDIALOG(PTR,0)) 35 TXT1 I TYPE'="W" S X=Y_ORP(DA,INST),Y="" D TXT^ORCHTAB 36 I TYPE="W" S ORI=0 F S ORI=$O(ORP(DA,INST,ORI)) Q:ORI'>0 D S Y="" 37 . S Y=$S(Y=" ":" ",$P(ORP(DA),U,5):" ",1:"") ;new line, or as stored 38 . S X=Y_ORP(DA,INST,ORI,0),Y="" 39 . I $E(X)'=" " D TXT^ORCHTAB Q ; wrap 40 . S:$L(ORTX(ORTX)) ORTX=ORTX+1,ORTX(ORTX)="" ; force new line 41 . I X?1." " S ORTX(ORTX)=" ",ORTX=ORTX+1,ORTX(ORTX)="" ; blank line 42 . E D TXT^ORCHTAB 43 D:$D(^ORD(101.41,+ORDIALOG,10,"DAD",PTR)) CHILD(PTR) 44 S INST=$O(ORP(DA,INST)) ; multiple? 45 I INST S ORTX(ORTX)=ORTX(ORTX)_",",Y="" S:NEWLN ORTX=ORTX+1,ORTX(ORTX)="",Y=" " G TXT1 46 S X=$$GETXT($P(ORP(DA),U,3)) D:$L(X) TXT^ORCHTAB ; trailing text 47 Q 48 ; 49 CHILD(PARENT) ; -- add child values 50 N CHSEQ,CHILD S CHSEQ=0 51 F S CHSEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,CHSEQ)) Q:CHSEQ'>0 S CHILD=$O(^(CHSEQ,0)) D 52 . Q:'$L($G(ORP(CHILD,INST))) 53 . S X=$$GETXT($P(ORP(CHILD),U,2)) D:$L(X) TXT^ORCHTAB ; lead text 54 . S X=ORP(CHILD,INST) D TXT^ORCHTAB 55 . S X=$$GETXT($P(ORP(CHILD),U,3)) D:$L(X) TXT^ORCHTAB ; trail text 56 Q 57 ; 58 GETXT(X) ; -- Returns text of X 59 I $E(X)="@" N VAR S VAR=$E(X,2,99),X=$G(@VAR) K @VAR ; variable w/text 60 Q X 61 ; 62 EXT ; -- Build ORP(DA) array of external forms 63 N PROMPT,INST,DA,NODE,FORMAT,OMIT,X,Y,TYPE,PTR 64 S PROMPT=0 F S PROMPT=$O(ORDIALOG(PROMPT)) Q:PROMPT'>0 D 65 . S DA=+$G(ORDIALOG(PROMPT)),TYPE=$E($G(ORDIALOG(PROMPT,0))) Q:'$L(TYPE) 66 . Q:'DA S NODE=$G(^ORD(101.41,ORDIALOG,10,DA,2)),FORMAT=$P(NODE,U,2),OMIT=$P(NODE,U,3) 67 . S:$D(ORDIALOG(PROMPT,"FORMAT")) FORMAT=ORDIALOG(PROMPT,"FORMAT") 68 . I $E(FORMAT)="@" S PTR=+$E(FORMAT,2,99) Q:'PTR ; Don't include 69 . S INST=0 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0 D 70 . . Q:ORDIALOG(PROMPT,INST)="" 71 . . I $E(FORMAT)="@",$L($G(ORDIALOG(PTR,INST))) Q ; use PTR instead 72 . . I $E(FORMAT)="*" S PTR=+$E(FORMAT,2,99) I '$L($G(ORDIALOG(PTR,INST))) Q ; must have PTR too 73 . . I $E(FORMAT)="=" S PTR=+$E(FORMAT,2,99) I PTR,$L($G(ORDIALOG(PTR,INST))) S Y=$$EXT^ORCD(PTR,INST),X=$$EXT^ORCD(PROMPT,INST) I (X=Y)!(X[Y)!(Y[X) Q 74 . . I TYPE="W" M ORP(DA,INST)=@ORDIALOG(PROMPT,INST) 75 . . E S X=$$EXT^ORCD(PROMPT,INST,FORMAT) Q:X="" Q:OMIT[X S ORP(DA,INST)=X 76 . . S ORP(DA)=PROMPT_U_$P(NODE,U,4,7) ; ptr^lead^trail^new line^wrap 77 Q 78 DIGTEXT(ORDER,ORDEA,ORSIGNER) ;Build text used to create Digital Signature 79 ;ORDER = ifn of order # (file 100) 80 ;ORDEA = Controlled substance schedule of drug (2-5) 81 ;ORSIGNER = DUZ of sigining physician 82 ;ORSET(1)=1)Date of Prescription (RX) -Date Ordered HL7 format 2)Full Patient Name 3)Patient SSN 4)DFN 83 ;ORSET(2)=5)Patient Street1 6)Patient Street2 7)Patient Street3 8)Patient City 9)Patient State 10)Patient Zip 11)??? 84 ;ORSET(3)=12)Drug name (From Dispense Drug or Orderable Item) 13)Variable ptr for Drug (file 50 or 101.43) 14)Drug quantity prescribed 15)Schedule of medication 16)DEA Schedule 85 ;ORSET(4)=17)Direction for use 86 ;ORSET(5)=18)Practitioner's name 19)DUZ 20)Practitioner's (DEA) registration number 87 ;ORSET(6)=22)SiteName 23)SiteStreet1 24)SiteStreet2 25)SiteCity 26)SiteState 27)SiteZip 88 ;ORSET(7)=28)$H 89 N I,DFN,OR80,ORPNM,ORSSN,ORXDT,VAERR,VAPA,X0,X1,X4,X5,X6,X8,X9,X10,X11,X12,X13,X14,SIG 90 S OR80=$G(^OR(100,ORDER,8,1,0)) 91 Q:'$L(OR80) 92 S:'$G(ORSIGNER) ORSIGNER=$P(OR80,"^",3) 93 Q:'ORSIGNER 94 S $P(^OR(100,ORDER,8,1,2),"^",4,5)=ORDEA_"^"_1 ;Flag to signing process to get digital signature 95 S ORXDT=$P(OR80,"^"),X1=$$FMTHL7^XLFDT(ORXDT),X4="",X14="",X10="" 96 I '$D(ORVP) S ORVP=$P(^OR(100,ORDER,0),"^",2) 97 S DFN=+ORVP 98 D ADD^VADPT 99 S ORPNM=^DPT(+ORVP,0),ORSSN=$P(ORPNM,"^",9),ORPNM=$P(ORPNM,"^") 100 F I=1:1:6 S X4=X4_$S($L($G(VAPA(I))):$S((I=5):$P(VAPA(I),"^",2),1:VAPA(I)),1:"")_"^" 101 S X11=$$GET1^DIQ(200,ORSIGNER,.01,"E") Q:'$L(X11) 102 S X12=$$DEA^XUSER(,ORSIGNER) 103 S X0=$$GET1^DIQ(4,+$G(DUZ(2)),.01,"E") 104 I $L(X0) S X14=X0_"^"_$$GET1^DIQ(4,DUZ(2),1.01,"E")_"^"_$$GET1^DIQ(4,DUZ(2),1.02,"E")_"^"_$$GET1^DIQ(4,DUZ(2),1.03,"E")_"^"_$$GET1^DIQ(4,DUZ(2),.02,"E")_"^"_$$GET1^DIQ(4,DUZ(2),1.04,"E") 105 S X5=$$VALUE^ORX8(ORDER,"DRUG",,"E"),X6=$$VALUE^ORX8(ORDER,"DRUG")_";50" 106 I '$L(X5) S X5=$$VALUE^ORX8(ORDER,"ORDERABLE",,"E"),X6=$$VALUE^ORX8(ORDER,"ORDERABLE")_";101.43" 107 S X8=$$VALUE^ORX8(ORDER,"QTY",,"E"),X9=$$VALUE^ORX8(ORDER,"SCHEDULE",,"E") 108 S SIG=+$O(^OR(100,ORDER,4.5,"ID","SIG",0)) I SIG,$L($G(^OR(100,ORDER,4.5,SIG,2,1,0))) S X10=^(0) 109 S ORSET(1)=X1_"^"_ORPNM_"^"_ORSSN_"^"_+ORVP_"^" 110 S ORSET(2)=X4_"^" 111 S ORSET(3)=X5_"^"_X6_"^"_X8_"^"_X9_"^"_ORDEA_"^" 112 S ORSET(4)=X10_"^" 113 S ORSET(5)=X11_"^"_ORSIGNER_"^"_X12_"^" 114 S ORSET(6)=X14 115 S ORSET(7)=$H 116 S ORSET=7 117 Q
Note:
See TracChangeset
for help on using the changeset viewer.
