ORY141EC ; SLC/JDL Event Capture Report ;6/14/02 13:06
;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997
;
POST ;Add ECS report to 101.24 and parameter ORWRP REPORT LIST
;
D CHKEC
;
;Add ECS report entry to 101.24
;
N ECPCE0,ECPCE2,ECPT0,ECPT2,ECS0,ECS2,PCEIEN,PTIEN,ECIEN
S ECPCE0="ORRP ECS PCE SUMMARY^OR_ECS1^^2^^^1^R^1^^^R"
S ECPCE2="^^Patient PCE Summary^Report from Event Capture"
S PCEIEN=$$ADDEC(ECPCE0,ECPCE2,"","")
S ECPT0="ORRP ECS PT SUMMARY^OR_ECS2^^2^^^1^R^1^^^R"
S ECPT2="^^Patient Data Summary^Report from Event Capture"
S PTIEN=$$ADDEC(ECPT0,ECPT2,"","")
S ECS0="ORRP ECS^OR_ECS^^^^^^R^1^^^M"
S ECS2="^^Event Capture^Event Capture Report"
S ECIEN=$$ADDEC(ECS0,ECS2,PCEIEN,PTIEN)
;
;Add ECS report to Reports tab
;
N OREC,ORI,ORP,ORT,FOUND,ORLST,ORERR
S ORERR=""
S ORP="ORWRP REPORT LIST",ORT=$O(^ORD(101.24,"B","ORRP ECS",0))
S OREC=$O(^ORD(101.24,"B","ORRP ECS",0)),ORI=0,FOUND=0
D GETLST^XPAR(.ORLST,"PKG",ORP,"Q",.ORERR)
F S ORI=$O(ORLST(ORI)) Q:+ORI=0!(FOUND) D
. S:$P(ORLST(ORI),U,2)=OREC FOUND=1
Q:+FOUND
S ORS=+ORLST(ORLST)+5
D PUT^XPAR("PKG",ORP,ORS,ORT)
Q
;
ADDEC(ND0,ND2,PCEID,PTID) ;Add ECS report to 101.24
N Y,I,LAST,TOTAL,HDR
S Y=0
S HDR=$G(^ORD(101.24,0)),TOTAL=$P(HDR,U,4),LAST=$O(^ORD(101.24,"?"),-1)
F I=1:1:10 L +^ORD(101.24,0):1 Q:$T H 2
S I=LAST F I=(I+1):1 Q:'$D(^ORD(101.24,I,0))
S Y=I,$P(HDR,U,3,4)=Y_U_(TOTAL+1)
S ^ORD(101.24,0)=HDR L -^ORD(101.24,0)
I $P(ND0,U,2)="OR_ECS" D
. S ^ORD(101.24,Y,0)=ND0
. S ^ORD(101.24,Y,2)=ND2
. S ^ORD(101.24,Y,10,0)="^101.241P^2^2"
. S ^ORD(101.24,Y,10,1,0)=PCEID_"^^1"
. S ^ORD(101.24,Y,10,2,0)=PTID_"^^2"
. S ^ORD(101.24,Y,10,"B",PCEID,1)=""
. S ^ORD(101.24,Y,10,"B",PTID,2)=""
. S ^ORD(101.24,"AC",$P(ND0,U,2),Y)=""
. S ^ORD(101.24,"B",$P(ND0,U,1),Y)=""
E D
. S ^ORD(101.24,Y,0)=ND0
. S ^ORD(101.24,Y,2)=ND2
. S ^ORD(101.24,"AC",$P(ND0,U,2),Y)=""
. S ^ORD(101.24,"B",$P(ND0,U,1),Y)=""
Q Y
;
CHKEC ;Check and Delete ECS entry from 101.24 and ORWRP REPROT LIST
N ORI,DA,DIK,X0
S ORI=0
F S ORI=$O(^ORD(101.24,ORI)) Q:'ORI D
. S X0=$P(^ORD(101.24,ORI,0),U,2)
. I (X0="OR_ECS")!(X0="OR_ECS1")!(X0="OR_ECS2") D
. . S DA=ORI,DIK="^ORD(101.24," D ^DIK
Q
ORY141EC ; SLC/JDL Event Capture Report ;6/14/02 13:06
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997
+2 ;
POST ;Add ECS report to 101.24 and parameter ORWRP REPORT LIST
+1 ;
+2 DO CHKEC
+3 ;
+4 ;Add ECS report entry to 101.24
+5 ;
+6 NEW ECPCE0,ECPCE2,ECPT0,ECPT2,ECS0,ECS2,PCEIEN,PTIEN,ECIEN
+7 SET ECPCE0="ORRP ECS PCE SUMMARY^OR_ECS1^^2^^^1^R^1^^^R"
+8 SET ECPCE2="^^Patient PCE Summary^Report from Event Capture"
+9 SET PCEIEN=$$ADDEC(ECPCE0,ECPCE2,"","")
+10 SET ECPT0="ORRP ECS PT SUMMARY^OR_ECS2^^2^^^1^R^1^^^R"
+11 SET ECPT2="^^Patient Data Summary^Report from Event Capture"
+12 SET PTIEN=$$ADDEC(ECPT0,ECPT2,"","")
+13 SET ECS0="ORRP ECS^OR_ECS^^^^^^R^1^^^M"
+14 SET ECS2="^^Event Capture^Event Capture Report"
+15 SET ECIEN=$$ADDEC(ECS0,ECS2,PCEIEN,PTIEN)
+16 ;
+17 ;Add ECS report to Reports tab
+18 ;
+19 NEW OREC,ORI,ORP,ORT,FOUND,ORLST,ORERR
+20 SET ORERR=""
+21 SET ORP="ORWRP REPORT LIST"
SET ORT=$ORDER(^ORD(101.24,"B","ORRP ECS",0))
+22 SET OREC=$ORDER(^ORD(101.24,"B","ORRP ECS",0))
SET ORI=0
SET FOUND=0
+23 DO GETLST^XPAR(.ORLST,"PKG",ORP,"Q",.ORERR)
+24 FOR
SET ORI=$ORDER(ORLST(ORI))
IF +ORI=0!(FOUND)
QUIT
Begin DoDot:1
+25 IF $PIECE(ORLST(ORI),U,2)=OREC
SET FOUND=1
End DoDot:1
+26 IF +FOUND
QUIT
+27 SET ORS=+ORLST(ORLST)+5
+28 DO PUT^XPAR("PKG",ORP,ORS,ORT)
+29 QUIT
+30 ;
ADDEC(ND0,ND2,PCEID,PTID) ;Add ECS report to 101.24
+1 NEW Y,I,LAST,TOTAL,HDR
+2 SET Y=0
+3 SET HDR=$GET(^ORD(101.24,0))
SET TOTAL=$PIECE(HDR,U,4)
SET LAST=$ORDER(^ORD(101.24,"?"),-1)
+4 FOR I=1:1:10
LOCK +^ORD(101.24,0):1
IF $TEST
QUIT
HANG 2
+5 SET I=LAST
FOR I=(I+1):1
IF '$DATA(^ORD(101.24,I,0))
QUIT
+6 SET Y=I
SET $PIECE(HDR,U,3,4)=Y_U_(TOTAL+1)
+7 SET ^ORD(101.24,0)=HDR
LOCK -^ORD(101.24,0)
+8 IF $PIECE(ND0,U,2)="OR_ECS"
Begin DoDot:1
+9 SET ^ORD(101.24,Y,0)=ND0
+10 SET ^ORD(101.24,Y,2)=ND2
+11 SET ^ORD(101.24,Y,10,0)="^101.241P^2^2"
+12 SET ^ORD(101.24,Y,10,1,0)=PCEID_"^^1"
+13 SET ^ORD(101.24,Y,10,2,0)=PTID_"^^2"
+14 SET ^ORD(101.24,Y,10,"B",PCEID,1)=""
+15 SET ^ORD(101.24,Y,10,"B",PTID,2)=""
+16 SET ^ORD(101.24,"AC",$PIECE(ND0,U,2),Y)=""
+17 SET ^ORD(101.24,"B",$PIECE(ND0,U,1),Y)=""
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 SET ^ORD(101.24,Y,0)=ND0
+20 SET ^ORD(101.24,Y,2)=ND2
+21 SET ^ORD(101.24,"AC",$PIECE(ND0,U,2),Y)=""
+22 SET ^ORD(101.24,"B",$PIECE(ND0,U,1),Y)=""
End DoDot:1
+23 QUIT Y
+24 ;
CHKEC ;Check and Delete ECS entry from 101.24 and ORWRP REPROT LIST
+1 NEW ORI,DA,DIK,X0
+2 SET ORI=0
+3 FOR
SET ORI=$ORDER(^ORD(101.24,ORI))
IF 'ORI
QUIT
Begin DoDot:1
+4 SET X0=$PIECE(^ORD(101.24,ORI,0),U,2)
+5 IF (X0="OR_ECS")!(X0="OR_ECS1")!(X0="OR_ECS2")
Begin DoDot:2
+6 SET DA=ORI
SET DIK="^ORD(101.24,"
DO ^DIK
End DoDot:2
End DoDot:1
+7 QUIT
