| 1 | ECPAT ;BIR/MAM,JPW-Event Capture Patient Summary ;26 Feb 96
|
---|
| 2 | ;;2.0; EVENT CAPTURE ;**5,18,47,72**;8 May 96
|
---|
| 3 | SET ; set ^TMP($J,"ECPAT")
|
---|
| 4 | N ECPXD,EC725
|
---|
| 5 | I $Y+8>IOSL D PAGE I ECOUT Q
|
---|
| 6 | S ECEC=$G(^ECH(ECFN,0))
|
---|
| 7 | S ECL=+$P(ECEC,"^",4),ECC=+$P(ECEC,"^",8),ECP=$P(ECEC,"^",9),ECD=+$P(ECEC,"^",7),ECV=+$P(ECEC,"^",10)
|
---|
| 8 | S ECU=$$GETPPRV^ECPRVMUT(ECFN,.ECUN),ECUN=$S(ECU:"UNKNOWN",1:$P(ECUN,"^",2))
|
---|
| 9 | Q:ECP']""
|
---|
| 10 | ;set default med spec and ord sect to administrative if blank
|
---|
| 11 | S ECM=$S($P(ECEC,"^",6)]"":+$P(ECEC,"^",6),1:108),ECO=$S($P(ECEC,"^",12)]"":+$P(ECEC,"^",12),1:108)
|
---|
| 12 | S ECMN=$S($P($G(^ECC(723,ECM,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
| 13 | S ECON=$S($P($G(^ECC(723,ECO,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
| 14 | S ECS=+$P(ECEC,"^",5),ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
| 15 | S ECCN=$S($P($G(^EC(726,ECC,0)),"^")]"":$P(^(0),"^"),1:"None")
|
---|
| 16 | S ECPSY=+$O(^ECJ("AP",ECL,ECD,ECC,ECP,""))
|
---|
| 17 | S ECPSYN=$P($G(^ECJ(ECPSY,"PRO")),"^",2)
|
---|
| 18 | S ECFILE=$P(ECP,";",2),ECFILE=$S($E(ECFILE)="I":81,1:725)
|
---|
| 19 | S ECCPT=$S(ECFILE=81:+ECP,1:$P($G(^EC(725,+ECP,0)),"^",5)),ECPXD=""
|
---|
| 20 | I ECCPT'="" D
|
---|
| 21 | . S ECPXD=$$CPT^ICPTCOD(ECCPT,$P(ECEC,"^",3)),ECCPT=$P(ECPXD,"^",2)
|
---|
| 22 | . I ECCPT'="" S ECCPT=ECCPT_" "
|
---|
| 23 | I ECFILE=81 S ECPN=$S($P(ECPXD,"^",3)]"":$P(ECPXD,"^",3),1:"UNKNOWN")
|
---|
| 24 | I ECFILE=725 D
|
---|
| 25 | .S EC725=$G(^EC(725,+ECP,0)),ECPN=$P(EC725,"^",2)_" "_$P(EC725,"^")
|
---|
| 26 | S ECPN=$J(ECCPT,6)_$E(ECPN,1,38)_$S(ECPSYN]"":" ["_ECPSYN_"] ",1:"")
|
---|
| 27 | S ECDN=$S($P($G(^ECD(ECD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
| 28 | S ECLN=$S($P($G(^DIC(4,ECL,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
| 29 | S ECUN=$S(ECUN'="UNKNOWN":$P(ECUN,",",2)_" "_$P(ECUN,","),1:"UNKNOWN")
|
---|
| 30 | S ECDT=$$FMTE^XLFDT(DATE)
|
---|
| 31 | ;
|
---|
| 32 | ;ALB/ESD - Add Procedure Reason to report
|
---|
| 33 | N ECLNK
|
---|
| 34 | S ECPRSN=""
|
---|
| 35 | S ECLNK=+$P(ECEC,"^",23)
|
---|
| 36 | I +ECLNK>0 DO
|
---|
| 37 | .S ECPRSN=$P($G(^ECL(ECLNK,0)),"^",1)
|
---|
| 38 | .S:+ECPRSN'>0 ECPRSN="REASON NOT DEFINED"
|
---|
| 39 | .S:+ECPRSN>0 ECPRSN=$P(^ECR(ECPRSN,0),"^",1)
|
---|
| 40 | S:+ECLNK'>0 ECPRSN="REASON NOT DEFINED"
|
---|
| 41 | ;
|
---|
| 42 | ;Get Procedure CPT modifiers
|
---|
| 43 | S ECMODF=0 K ECMOD
|
---|
| 44 | I $O(^ECH(ECFN,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECFN,"E",.ECMOD)
|
---|
| 45 | I $D(ECY) DO
|
---|
| 46 | .W !!,ECDT,?25,ECCN,?80,ECPN_" ("_ECV_")",!
|
---|
| 47 | .I ECMODF S MD="" D K MD I ECOUT Q
|
---|
| 48 | ..F S MD=$O(ECMOD(MD)) Q:MD="" D I ECOUT Q
|
---|
| 49 | ...D:$Y+2>IOSL PAGE Q:ECOUT W ?84,"- ",MD," ",$P(ECMOD(MD),U,3),!
|
---|
| 50 | .W $E(ECLN,1,22),?25,ECSN,?80,ECMN,!
|
---|
| 51 | .W:$D(ECRY) ECPRSN
|
---|
| 52 | .W ?25,ECON,?80,ECUN
|
---|
| 53 | I $D(ECN) DO
|
---|
| 54 | .W !!,ECDT,?25,ECPN_" ("_ECV_")",!
|
---|
| 55 | .I ECMODF S MD="" D K MD I ECOUT Q
|
---|
| 56 | ..F S MD=$O(ECMOD(MD)) Q:MD="" D I ECOUT Q
|
---|
| 57 | ...D:$Y+2>IOSL PAGE Q:ECOUT W ?29,"- ",MD," ",$P(ECMOD(MD),U,3),!
|
---|
| 58 | .W $E(ECLN,1,22),?25,ECSN,?80,ECMN,!
|
---|
| 59 | .W:$D(ECRY) ECPRSN
|
---|
| 60 | .W ?25,ECON,?80,ECUN
|
---|
| 61 | Q
|
---|
| 62 | PAT ; entry point
|
---|
| 63 | K DIC S DIC=2,DIC(0)="QEAMZ",DIC("A")="Select Patient: " D ^DIC K DIC G:Y<0 END S ECDFN=+Y,ECPAT=$P(Y,"^",2)
|
---|
| 64 | DATE K %DT S %DT="AEX",%DT("A")="Start with Date: " D ^%DT G:Y<0 END S ECSD=Y,%DT("A")="End with Date: " D ^%DT G:Y<0 END S ECED=Y I ECED<ECSD W !,"End date must be after start date",! G DATE
|
---|
| 65 | S ECDATE=$$FMTE^XLFDT(ECSD)_"^"_$$FMTE^XLFDT(ECED),ECSD=ECSD-.0001,ECED=ECED+.9999
|
---|
| 66 | D REASON^ECRUTL ;* Prompt to report Procedure Reasons
|
---|
| 67 | K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Select Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS G:POP END
|
---|
| 68 | I $D(IO("Q")) S:$D(ECRY) ZTSAVE("ECRY")=""
|
---|
| 69 | I $D(IO("Q")) K IO("Q") S (ZTSAVE("ECDFN"),ZTSAVE("ECPAT"),ZTSAVE("ECDATE"),ZTSAVE("ECED"),ZTSAVE("ECSD"))="",ZTDESC="EVENT CAPTURE PATIENT SUMMARY",ZTRTN="SUM^ECPAT",ZTIO=ION D ^%ZTLOAD,HOME^%ZIS G END
|
---|
| 70 | SUM ; entry when queued
|
---|
| 71 | S %H=$H D YX^%DTC S ECRDT=Y
|
---|
| 72 | U IO S DATE=$O(^ECH("APAT",ECDFN,ECSD)) I 'DATE W:$Y @IOF W !!,"No Data for "_ECPAT_" during the time selected." G END
|
---|
| 73 | S ECFN=+$O(^ECH("APAT",ECDFN,DATE,0)),ECL=+$P(^ECH(ECFN,0),"^",4) D BRO D:$D(ECY) HDR D:$D(ECN) HDR1
|
---|
| 74 | S DATE=ECSD,(ECFN,ECOUT)=0 F I=0:0 S DATE=$O(^ECH("APAT",ECDFN,DATE)) Q:'DATE!(DATE>ECED)!(ECOUT) F I=0:0 S ECFN=$O(^ECH("APAT",ECDFN,DATE,ECFN)) Q:'ECFN!(ECOUT) D SET
|
---|
| 75 | END I $D(ECGUI) D ^ECKILL Q
|
---|
| 76 | W ! I $D(ECOUT),'ECOUT D
|
---|
| 77 | . I $E(IOST,1,2)="C-" W !!,"Press <RET> to continue " R X:DTIME
|
---|
| 78 | W @IOF D ^%ZISC D ^ECKILL S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 79 | Q
|
---|
| 80 | HDR ; print heading
|
---|
| 81 | ;
|
---|
| 82 | ;ALB/ESD - Add Procedure Reason to column headings
|
---|
| 83 | W:$Y @IOF
|
---|
| 84 | W !,?32,"EVENT CAPTURE PATIENT SUMMARY FOR "_ECPAT,!,?32,"FROM "_$P(ECDATE,"^")_" TO "_$P(ECDATE,"^",2),!,?32,"Run Date : ",ECRDT
|
---|
| 85 | W !,"PROCEDURE DATE/TIME",?25,"CATEGORY",?80,"PROCEDURE",!,?80,"PROCEDURE (CPT) MODIFIER",!,"LOCATION",?25,"SERVICE",?80,"SECTION"
|
---|
| 86 | W !
|
---|
| 87 | W:$D(ECRY) "PROCEDURE REASON"
|
---|
| 88 | W ?25,"ORDERING SECTION",?80,"PROVIDER",! F LINE=1:1:132 W "-"
|
---|
| 89 | W !
|
---|
| 90 | Q
|
---|
| 91 | PAGE ; end of page
|
---|
| 92 | S X="" I $E(IOST,1,2)="C-" W !!,"Press <RET> to continue, or ^ to quit " R X:DTIME I '$T!(X="^") S ECOUT=1 Q
|
---|
| 93 | I X["?" W !!,"If you want to continue with this report, press <RET>. Entering an ^ will",!,"exit you from this option." G PAGE
|
---|
| 94 | D:$D(ECY) HDR D:$D(ECN) HDR1
|
---|
| 95 | Q
|
---|
| 96 | HDR1 ; print heading without categories
|
---|
| 97 | ;
|
---|
| 98 | ;ALB/ESD - Add Run Date to header
|
---|
| 99 | W @IOF,!!,?32,"EVENT CAPTURE PATIENT SUMMARY FOR "_ECPAT,!,?36,"FROM "_$P(ECDATE,"^")_" TO "_$P(ECDATE,"^",2),!,?36,"Run Date : ",ECRDT
|
---|
| 100 | ;
|
---|
| 101 | ;ALB/ESD - Add Procedure Reason to column headings
|
---|
| 102 | W !!,"PROCEDURE DATE/TIME",?25,"PROCEDURE(VOLUME)",!,?25,"PROCEDURE (CPT) MODIFIER",!,"LOCATION",?25,"SERVICE",?80,"SECTION"
|
---|
| 103 | W !
|
---|
| 104 | W:$D(ECRY) "PROCEDURE REASON"
|
---|
| 105 | W ?25,"ORDERING SECTION",?80,"PROVIDER",! F LINE=1:1:132 W "-"
|
---|
| 106 | W !
|
---|
| 107 | Q
|
---|
| 108 | BRO ;ask prt with category or without
|
---|
| 109 | S ECN=1
|
---|
| 110 | Q
|
---|