ORCSAVE1 ; SLC/MKB - Save Order Text ;02/22/07
;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,132,141,163,187,223,243**;Dec 17, 1997;Build 242
;
; ^ORD(101.41,+ORDIALOG,10,ITM,2)=Seq#^Format^Omit^Lead Text^Trail Text
; ^ORD(101.41,+ORDIALOG,10,"ATXT",Seq#,ITM)=""
;
ORDTEXT(ORDER) ; -- Build and save order text from ORDIALOG() into ORDER
N ORTX,I,IFN,ACT,ORSET
D ORTX(240) Q:'$G(ORTX)
S IFN=+ORDER,ACT=+$P(ORDER,";",2) S:ACT'>0 ACT=1
F I=1:1:ORTX S ^OR(100,IFN,8,ACT,.1,I,0)=ORTX(I)
S ^OR(100,IFN,8,ACT,.1,0)=U_U_ORTX_U_ORTX_U_DT_U
I $E($G(ORDEA))=2 D ;PKI Drug Schedule - in future may allow 2-5
. S ORSET=0
. D DIGTEXT(IFN,ORDEA)
. F I=1:1:ORSET S ^OR(100,IFN,8,ACT,.2,I,0)=ORSET(I)
. I ORSET>0 S ^OR(100,IFN,8,ACT,.2,0)=U_U_ORSET_U_ORSET_U_DT_U
Q
;
ORTX(WIDTH) ; -- May enter here to return order text in ORTX()
N ORP,SEQ,ITEM,ORMAX,IVIEN,IVITEM,IVTYPE,RATE
K ORTX S ORMAX=$S(+$G(WIDTH):WIDTH,1:240)
D EXT ; get external form of values
S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"ATXT",SEQ)) Q:SEQ'>0 D
. S ITEM=0 F S ITEM=$O(^ORD(101.41,+ORDIALOG,10,"ATXT",SEQ,ITEM)) Q:ITEM'>0 D TEXT(ITEM)
Q
;
TEXT(DA) ; -- Includes text of item DA
Q:$P(^ORD(101.41,ORDIALOG,10,DA,0),U,11) Q:'$O(ORP(DA,0))
N NEWLN,INST,TYPE,PTR,CHSEQ,CHILD,ORI,X,Y
S:'$G(ORTX) ORTX=1,ORTX(1)=""
S NEWLN=+$P(ORP(DA),U,4),INST=$O(ORP(DA,0)),Y=""
I NEWLN,$L(ORTX(ORTX)) S ORTX=ORTX+1,ORTX(ORTX)="",Y=" "
S X=$$GETXT($P(ORP(DA),U,2)) I $L(X) S X=Y_X,Y="" D TXT^ORCHTAB ;lead tx
S PTR=+ORP(DA),TYPE=$E(ORDIALOG(PTR,0))
TXT1 I TYPE'="W" S X=Y_ORP(DA,INST),Y="" D TXT^ORCHTAB
I TYPE="W" S ORI=0 F S ORI=$O(ORP(DA,INST,ORI)) Q:ORI'>0 D S Y=""
. S Y=$S(Y=" ":" ",$P(ORP(DA),U,5):" ",1:"") ;new line, or as stored
. S X=Y_ORP(DA,INST,ORI,0),Y=""
. I $E(X)'=" " D TXT^ORCHTAB Q ; wrap
. S:$L(ORTX(ORTX)) ORTX=ORTX+1,ORTX(ORTX)="" ; force new line
. I X?1." " S ORTX(ORTX)=" ",ORTX=ORTX+1,ORTX(ORTX)="" ; blank line
. E D TXT^ORCHTAB
D:$D(^ORD(101.41,+ORDIALOG,10,"DAD",PTR)) CHILD(PTR)
S INST=$O(ORP(DA,INST)) ; multiple?
I INST S ORTX(ORTX)=ORTX(ORTX)_",",Y="" S:NEWLN ORTX=ORTX+1,ORTX(ORTX)="",Y=" " G TXT1
S X=$$GETXT($P(ORP(DA),U,3)) D:$L(X) TXT^ORCHTAB ; trailing text
Q
;
CHILD(PARENT) ; -- add child values
N CHSEQ,CHILD S CHSEQ=0
F S CHSEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,CHSEQ)) Q:CHSEQ'>0 S CHILD=$O(^(CHSEQ,0)) D
. Q:'$L($G(ORP(CHILD,INST)))
. S X=$$GETXT($P(ORP(CHILD),U,2)) D:$L(X) TXT^ORCHTAB ; lead text
. S X=ORP(CHILD,INST) D TXT^ORCHTAB
. S X=$$GETXT($P(ORP(CHILD),U,3)) D:$L(X) TXT^ORCHTAB ; trail text
Q
;
GETXT(X) ; -- Returns text of X
I $E(X)="@" N VAR S VAR=$E(X,2,99),X=$G(@VAR) K @VAR ; variable w/text
Q X
;
EXT ; -- Build ORP(DA) array of external forms
N PROMPT,INST,DA,NODE,FORMAT,OMIT,X,Y,TYPE,PTR
S PROMPT=0 F S PROMPT=$O(ORDIALOG(PROMPT)) Q:PROMPT'>0 D
. S DA=+$G(ORDIALOG(PROMPT)),TYPE=$E($G(ORDIALOG(PROMPT,0))) Q:'$L(TYPE)
. Q:'DA S NODE=$G(^ORD(101.41,ORDIALOG,10,DA,2)),FORMAT=$P(NODE,U,2),OMIT=$P(NODE,U,3)
. S:$D(ORDIALOG(PROMPT,"FORMAT")) FORMAT=ORDIALOG(PROMPT,"FORMAT")
. I $E(FORMAT)="@" S PTR=+$E(FORMAT,2,99) Q:'PTR ; Don't include
. S INST=0 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0 D
. . Q:ORDIALOG(PROMPT,INST)=""
. . I $E(FORMAT)="@",$L($G(ORDIALOG(PTR,INST))) Q ; use PTR instead
. . I $E(FORMAT)="*" S PTR=+$E(FORMAT,2,99) I '$L($G(ORDIALOG(PTR,INST))) Q ; must have PTR too
. . 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
. . I TYPE="W" M ORP(DA,INST)=@ORDIALOG(PROMPT,INST)
. . E S X=$$EXT^ORCD(PROMPT,INST,FORMAT) Q:X="" Q:OMIT[X S ORP(DA,INST)=X
. . S ORP(DA)=PROMPT_U_$P(NODE,U,4,7) ; ptr^lead^trail^new line^wrap
Q
DIGTEXT(ORDER,ORDEA,ORSIGNER) ;Build text used to create Digital Signature
;ORDER = ifn of order # (file 100)
;ORDEA = Controlled substance schedule of drug (2-5)
;ORSIGNER = DUZ of sigining physician
;ORSET(1)=1)Date of Prescription (RX) -Date Ordered HL7 format 2)Full Patient Name 3)Patient SSN 4)DFN
;ORSET(2)=5)Patient Street1 6)Patient Street2 7)Patient Street3 8)Patient City 9)Patient State 10)Patient Zip 11)???
;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
;ORSET(4)=17)Direction for use
;ORSET(5)=18)Practitioner's name 19)DUZ 20)Practitioner's (DEA) registration number
;ORSET(6)=22)SiteName 23)SiteStreet1 24)SiteStreet2 25)SiteCity 26)SiteState 27)SiteZip
;ORSET(7)=28)$H
N I,DFN,OR80,ORPNM,ORSSN,ORXDT,VAERR,VAPA,X0,X1,X4,X5,X6,X8,X9,X10,X11,X12,X13,X14,SIG
S OR80=$G(^OR(100,ORDER,8,1,0))
Q:'$L(OR80)
S:'$G(ORSIGNER) ORSIGNER=$P(OR80,"^",3)
Q:'ORSIGNER
S $P(^OR(100,ORDER,8,1,2),"^",4,5)=ORDEA_"^"_1 ;Flag to signing process to get digital signature
S ORXDT=$P(OR80,"^"),X1=$$FMTHL7^XLFDT(ORXDT),X4="",X14="",X10=""
I '$D(ORVP) S ORVP=$P(^OR(100,ORDER,0),"^",2)
S DFN=+ORVP
D ADD^VADPT
S ORPNM=^DPT(+ORVP,0),ORSSN=$P(ORPNM,"^",9),ORPNM=$P(ORPNM,"^")
F I=1:1:6 S X4=X4_$S($L($G(VAPA(I))):$S((I=5):$P(VAPA(I),"^",2),1:VAPA(I)),1:"")_"^"
S X11=$$GET1^DIQ(200,ORSIGNER,.01,"E") Q:'$L(X11)
S X12=$$DEA^XUSER(,ORSIGNER)
S X0=$$GET1^DIQ(4,+$G(DUZ(2)),.01,"E")
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")
S X5=$$VALUE^ORX8(ORDER,"DRUG",,"E"),X6=$$VALUE^ORX8(ORDER,"DRUG")_";50"
I '$L(X5) S X5=$$VALUE^ORX8(ORDER,"ORDERABLE",,"E"),X6=$$VALUE^ORX8(ORDER,"ORDERABLE")_";101.43"
S X8=$$VALUE^ORX8(ORDER,"QTY",,"E"),X9=$$VALUE^ORX8(ORDER,"SCHEDULE",,"E")
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)
S ORSET(1)=X1_"^"_ORPNM_"^"_ORSSN_"^"_+ORVP_"^"
S ORSET(2)=X4_"^"
S ORSET(3)=X5_"^"_X6_"^"_X8_"^"_X9_"^"_ORDEA_"^"
S ORSET(4)=X10_"^"
S ORSET(5)=X11_"^"_ORSIGNER_"^"_X12_"^"
S ORSET(6)=X14
S ORSET(7)=$H
S ORSET=7
Q
ORCSAVE1 ; SLC/MKB - Save Order Text ;02/22/07
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,132,141,163,187,223,243**;Dec 17, 1997;Build 242
+2 ;
+3 ; ^ORD(101.41,+ORDIALOG,10,ITM,2)=Seq#^Format^Omit^Lead Text^Trail Text
+4 ; ^ORD(101.41,+ORDIALOG,10,"ATXT",Seq#,ITM)=""
+5 ;
ORDTEXT(ORDER) ; -- Build and save order text from ORDIALOG() into ORDER
+1 NEW ORTX,I,IFN,ACT,ORSET
+2 DO ORTX(240)
IF '$GET(ORTX)
QUIT
+3 SET IFN=+ORDER
SET ACT=+$PIECE(ORDER,";",2)
IF ACT'>0
SET ACT=1
+4 FOR I=1:1:ORTX
SET ^OR(100,IFN,8,ACT,.1,I,0)=ORTX(I)
+5 SET ^OR(100,IFN,8,ACT,.1,0)=U_U_ORTX_U_ORTX_U_DT_U
+6 ;PKI Drug Schedule - in future may allow 2-5
IF $EXTRACT($GET(ORDEA))=2
Begin DoDot:1
+7 SET ORSET=0
+8 DO DIGTEXT(IFN,ORDEA)
+9 FOR I=1:1:ORSET
SET ^OR(100,IFN,8,ACT,.2,I,0)=ORSET(I)
+10 IF ORSET>0
SET ^OR(100,IFN,8,ACT,.2,0)=U_U_ORSET_U_ORSET_U_DT_U
End DoDot:1
+11 QUIT
+12 ;
ORTX(WIDTH) ; -- May enter here to return order text in ORTX()
+1 NEW ORP,SEQ,ITEM,ORMAX,IVIEN,IVITEM,IVTYPE,RATE
+2 KILL ORTX
SET ORMAX=$SELECT(+$GET(WIDTH):WIDTH,1:240)
+3 ; get external form of values
DO EXT
+4 SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"ATXT",SEQ))
IF SEQ'>0
QUIT
Begin DoDot:1
+5 SET ITEM=0
FOR
SET ITEM=$ORDER(^ORD(101.41,+ORDIALOG,10,"ATXT",SEQ,ITEM))
IF ITEM'>0
QUIT
DO TEXT(ITEM)
End DoDot:1
+6 QUIT
+7 ;
TEXT(DA) ; -- Includes text of item DA
+1 IF $PIECE(^ORD(101.41,ORDIALOG,10,DA,0),U,11)
QUIT
IF '$ORDER(ORP(DA,0))
QUIT
+2 NEW NEWLN,INST,TYPE,PTR,CHSEQ,CHILD,ORI,X,Y
+3 IF '$GET(ORTX)
SET ORTX=1
SET ORTX(1)=""
+4 SET NEWLN=+$PIECE(ORP(DA),U,4)
SET INST=$ORDER(ORP(DA,0))
SET Y=""
+5 IF NEWLN
IF $LENGTH(ORTX(ORTX))
SET ORTX=ORTX+1
SET ORTX(ORTX)=""
SET Y=" "
+6 ;lead tx
SET X=$$GETXT($PIECE(ORP(DA),U,2))
IF $LENGTH(X)
SET X=Y_X
SET Y=""
DO TXT^ORCHTAB
+7 SET PTR=+ORP(DA)
SET TYPE=$EXTRACT(ORDIALOG(PTR,0))
TXT1 IF TYPE'="W"
SET X=Y_ORP(DA,INST)
SET Y=""
DO TXT^ORCHTAB
+1 IF TYPE="W"
SET ORI=0
FOR
SET ORI=$ORDER(ORP(DA,INST,ORI))
IF ORI'>0
QUIT
Begin DoDot:1
+2 ;new line, or as stored
SET Y=$SELECT(Y=" ":" ",$PIECE(ORP(DA),U,5):" ",1:"")
+3 SET X=Y_ORP(DA,INST,ORI,0)
SET Y=""
+4 ; wrap
IF $EXTRACT(X)'=" "
DO TXT^ORCHTAB
QUIT
+5 ; force new line
IF $LENGTH(ORTX(ORTX))
SET ORTX=ORTX+1
SET ORTX(ORTX)=""
+6 ; blank line
IF X?1." "
SET ORTX(ORTX)=" "
SET ORTX=ORTX+1
SET ORTX(ORTX)=""
+7 IF '$TEST
DO TXT^ORCHTAB
End DoDot:1
SET Y=""
+8 IF $DATA(^ORD(101.41,+ORDIALOG,10,"DAD",PTR))
DO CHILD(PTR)
+9 ; multiple?
SET INST=$ORDER(ORP(DA,INST))
+10 IF INST
SET ORTX(ORTX)=ORTX(ORTX)_","
SET Y=""
IF NEWLN
SET ORTX=ORTX+1
SET ORTX(ORTX)=""
SET Y=" "
GOTO TXT1
+11 ; trailing text
SET X=$$GETXT($PIECE(ORP(DA),U,3))
IF $LENGTH(X)
DO TXT^ORCHTAB
+12 QUIT
+13 ;
CHILD(PARENT) ; -- add child values
+1 NEW CHSEQ,CHILD
SET CHSEQ=0
+2 FOR
SET CHSEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,CHSEQ))
IF CHSEQ'>0
QUIT
SET CHILD=$ORDER(^(CHSEQ,0))
Begin DoDot:1
+3 IF '$LENGTH($GET(ORP(CHILD,INST)))
QUIT
+4 ; lead text
SET X=$$GETXT($PIECE(ORP(CHILD),U,2))
IF $LENGTH(X)
DO TXT^ORCHTAB
+5 SET X=ORP(CHILD,INST)
DO TXT^ORCHTAB
+6 ; trail text
SET X=$$GETXT($PIECE(ORP(CHILD),U,3))
IF $LENGTH(X)
DO TXT^ORCHTAB
End DoDot:1
+7 QUIT
+8 ;
GETXT(X) ; -- Returns text of X
+1 ; variable w/text
IF $EXTRACT(X)="@"
NEW VAR
SET VAR=$EXTRACT(X,2,99)
SET X=$GET(@VAR)
KILL @VAR
+2 QUIT X
+3 ;
EXT ; -- Build ORP(DA) array of external forms
+1 NEW PROMPT,INST,DA,NODE,FORMAT,OMIT,X,Y,TYPE,PTR
+2 SET PROMPT=0
FOR
SET PROMPT=$ORDER(ORDIALOG(PROMPT))
IF PROMPT'>0
QUIT
Begin DoDot:1
+3 SET DA=+$GET(ORDIALOG(PROMPT))
SET TYPE=$EXTRACT($GET(ORDIALOG(PROMPT,0)))
IF '$LENGTH(TYPE)
QUIT
+4 IF 'DA
QUIT
SET NODE=$GET(^ORD(101.41,ORDIALOG,10,DA,2))
SET FORMAT=$PIECE(NODE,U,2)
SET OMIT=$PIECE(NODE,U,3)
+5 IF $DATA(ORDIALOG(PROMPT,"FORMAT"))
SET FORMAT=ORDIALOG(PROMPT,"FORMAT")
+6 ; Don't include
IF $EXTRACT(FORMAT)="@"
SET PTR=+$EXTRACT(FORMAT,2,99)
IF 'PTR
QUIT
+7 SET INST=0
FOR
SET INST=$ORDER(ORDIALOG(PROMPT,INST))
IF INST'>0
QUIT
Begin DoDot:2
+8 IF ORDIALOG(PROMPT,INST)=""
QUIT
+9 ; use PTR instead
IF $EXTRACT(FORMAT)="@"
IF $LENGTH($GET(ORDIALOG(PTR,INST)))
QUIT
+10 ; must have PTR too
IF $EXTRACT(FORMAT)="*"
SET PTR=+$EXTRACT(FORMAT,2,99)
IF '$LENGTH($GET(ORDIALOG(PTR,INST)))
QUIT
+11 IF $EXTRACT(FORMAT)="="
SET PTR=+$EXTRACT(FORMAT,2,99)
IF PTR
IF $LENGTH($GET(ORDIALOG(PTR,INST)))
SET Y=$$EXT^ORCD(PTR,INST)
SET X=$$EXT^ORCD(PROMPT,INST)
IF (X=Y)!(X[Y)!(Y[X)
QUIT
+12 IF TYPE="W"
MERGE ORP(DA,INST)=@ORDIALOG(PROMPT,INST)
+13 IF '$TEST
SET X=$$EXT^ORCD(PROMPT,INST,FORMAT)
IF X=""
QUIT
IF OMIT[X
QUIT
SET ORP(DA,INST)=X
+14 ; ptr^lead^trail^new line^wrap
SET ORP(DA)=PROMPT_U_$PIECE(NODE,U,4,7)
End DoDot:2
End DoDot:1
+15 QUIT
DIGTEXT(ORDER,ORDEA,ORSIGNER) ;Build text used to create Digital Signature
+1 ;ORDER = ifn of order # (file 100)
+2 ;ORDEA = Controlled substance schedule of drug (2-5)
+3 ;ORSIGNER = DUZ of sigining physician
+4 ;ORSET(1)=1)Date of Prescription (RX) -Date Ordered HL7 format 2)Full Patient Name 3)Patient SSN 4)DFN
+5 ;ORSET(2)=5)Patient Street1 6)Patient Street2 7)Patient Street3 8)Patient City 9)Patient State 10)Patient Zip 11)???
+6 ;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
+7 ;ORSET(4)=17)Direction for use
+8 ;ORSET(5)=18)Practitioner's name 19)DUZ 20)Practitioner's (DEA) registration number
+9 ;ORSET(6)=22)SiteName 23)SiteStreet1 24)SiteStreet2 25)SiteCity 26)SiteState 27)SiteZip
+10 ;ORSET(7)=28)$H
+11 NEW I,DFN,OR80,ORPNM,ORSSN,ORXDT,VAERR,VAPA,X0,X1,X4,X5,X6,X8,X9,X10,X11,X12,X13,X14,SIG
+12 SET OR80=$GET(^OR(100,ORDER,8,1,0))
+13 IF '$LENGTH(OR80)
QUIT
+14 IF '$GET(ORSIGNER)
SET ORSIGNER=$PIECE(OR80,"^",3)
+15 IF 'ORSIGNER
QUIT
+16 ;Flag to signing process to get digital signature
SET $PIECE(^OR(100,ORDER,8,1,2),"^",4,5)=ORDEA_"^"_1
+17 SET ORXDT=$PIECE(OR80,"^")
SET X1=$$FMTHL7^XLFDT(ORXDT)
SET X4=""
SET X14=""
SET X10=""
+18 IF '$DATA(ORVP)
SET ORVP=$PIECE(^OR(100,ORDER,0),"^",2)
+19 SET DFN=+ORVP
+20 DO ADD^VADPT
+21 SET ORPNM=^DPT(+ORVP,0)
SET ORSSN=$PIECE(ORPNM,"^",9)
SET ORPNM=$PIECE(ORPNM,"^")
+22 FOR I=1:1:6
SET X4=X4_$SELECT($LENGTH($GET(VAPA(I))):$SELECT((I=5):$PIECE(VAPA(I),"^",2),1:VAPA(I)),1:"")_"^"
+23 SET X11=$$GET1^DIQ(200,ORSIGNER,.01,"E")
IF '$LENGTH(X11)
QUIT
+24 SET X12=$$DEA^XUSER(,ORSIGNER)
+25 SET X0=$$GET1^DIQ(4,+$GET(DUZ(2)),.01,"E")
+26 IF $LENGTH(X0)
SET 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")
+27 SET X5=$$VALUE^ORX8(ORDER,"DRUG",,"E")
SET X6=$$VALUE^ORX8(ORDER,"DRUG")_";50"
+28 IF '$LENGTH(X5)
SET X5=$$VALUE^ORX8(ORDER,"ORDERABLE",,"E")
SET X6=$$VALUE^ORX8(ORDER,"ORDERABLE")_";101.43"
+29 SET X8=$$VALUE^ORX8(ORDER,"QTY",,"E")
SET X9=$$VALUE^ORX8(ORDER,"SCHEDULE",,"E")
+30 SET SIG=+$ORDER(^OR(100,ORDER,4.5,"ID","SIG",0))
IF SIG
IF $LENGTH($GET(^OR(100,ORDER,4.5,SIG,2,1,0)))
SET X10=^(0)
+31 SET ORSET(1)=X1_"^"_ORPNM_"^"_ORSSN_"^"_+ORVP_"^"
+32 SET ORSET(2)=X4_"^"
+33 SET ORSET(3)=X5_"^"_X6_"^"_X8_"^"_X9_"^"_ORDEA_"^"
+34 SET ORSET(4)=X10_"^"
+35 SET ORSET(5)=X11_"^"_ORSIGNER_"^"_X12_"^"
+36 SET ORSET(6)=X14
+37 SET ORSET(7)=$HOROLOG
+38 SET ORSET=7
+39 QUIT
