EMERGENCY Released ECX*3*169 SEQ #151 Extracted from mail message **KIDS**:ECX*3.0*169^ **INSTALL NAME** ECX*3.0*169 "BLD",10322,0) ECX*3.0*169^DSS EXTRACTS^0^3171115^y "BLD",10322,4,0) ^9.64PA^^ "BLD",10322,6.3) 2 "BLD",10322,"ABPKG") n "BLD",10322,"KRN",0) ^9.67PA^779.2^20 "BLD",10322,"KRN",.4,0) .4 "BLD",10322,"KRN",.401,0) .401 "BLD",10322,"KRN",.402,0) .402 "BLD",10322,"KRN",.403,0) .403 "BLD",10322,"KRN",.5,0) .5 "BLD",10322,"KRN",.84,0) .84 "BLD",10322,"KRN",3.6,0) 3.6 "BLD",10322,"KRN",3.8,0) 3.8 "BLD",10322,"KRN",9.2,0) 9.2 "BLD",10322,"KRN",9.8,0) 9.8 "BLD",10322,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",10322,"KRN",9.8,"NM",1,0) ECXWRD^^0^B18988653 "BLD",10322,"KRN",9.8,"NM",2,0) ECXPRO^^0^B51537210 "BLD",10322,"KRN",9.8,"NM",3,0) ECXATRT^^0^B71794842 "BLD",10322,"KRN",9.8,"NM","B","ECXATRT",3) "BLD",10322,"KRN",9.8,"NM","B","ECXPRO",2) "BLD",10322,"KRN",9.8,"NM","B","ECXWRD",1) "BLD",10322,"KRN",19,0) 19 "BLD",10322,"KRN",19.1,0) 19.1 "BLD",10322,"KRN",101,0) 101 "BLD",10322,"KRN",409.61,0) 409.61 "BLD",10322,"KRN",771,0) 771 "BLD",10322,"KRN",779.2,0) 779.2 "BLD",10322,"KRN",870,0) 870 "BLD",10322,"KRN",8989.51,0) 8989.51 "BLD",10322,"KRN",8989.52,0) 8989.52 "BLD",10322,"KRN",8994,0) 8994 "BLD",10322,"KRN","B",.4,.4) "BLD",10322,"KRN","B",.401,.401) "BLD",10322,"KRN","B",.402,.402) "BLD",10322,"KRN","B",.403,.403) "BLD",10322,"KRN","B",.5,.5) "BLD",10322,"KRN","B",.84,.84) "BLD",10322,"KRN","B",3.6,3.6) "BLD",10322,"KRN","B",3.8,3.8) "BLD",10322,"KRN","B",9.2,9.2) "BLD",10322,"KRN","B",9.8,9.8) "BLD",10322,"KRN","B",19,19) "BLD",10322,"KRN","B",19.1,19.1) "BLD",10322,"KRN","B",101,101) "BLD",10322,"KRN","B",409.61,409.61) "BLD",10322,"KRN","B",771,771) "BLD",10322,"KRN","B",779.2,779.2) "BLD",10322,"KRN","B",870,870) "BLD",10322,"KRN","B",8989.51,8989.51) "BLD",10322,"KRN","B",8989.52,8989.52) "BLD",10322,"KRN","B",8994,8994) "BLD",10322,"QUES",0) ^9.62^^ "BLD",10322,"REQB",0) ^9.611^1^1 "BLD",10322,"REQB",1,0) ECX*3.0*166^1 "BLD",10322,"REQB","B","ECX*3.0*166",1) "MBREQ") 0 "PKG",535,-1) 1^1 "PKG",535,0) DSS EXTRACTS^ECX "PKG",535,20,0) ^9.402P^^ "PKG",535,22,0) ^9.49I^1^1 "PKG",535,22,1,0) 3.0^2971222^3000224^66481 "PKG",535,22,1,"PAH",1,0) 169^3171115 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 3 "RTN","ECXATRT") 0^3^B71794842^B70445295 "RTN","ECXATRT",1,0) ECXATRT ;ALB/JAP - TRT Extract Audit Report ;11/15/17 10:30 "RTN","ECXATRT",2,0) ;;3.0;DSS EXTRACTS;**1,6,8,107,105,149,169**;Dec 22, 1997;Build 2 "RTN","ECXATRT",3,0) ; "RTN","ECXATRT",4,0) EN ;entry point for TRT extract audit report "RTN","ECXATRT",5,0) N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,ECXPORT,RCNT ;149 "RTN","ECXATRT",6,0) S ECXERR=0 "RTN","ECXATRT",7,0) ;ecxaud=0 for 'extract' audit "RTN","ECXATRT",8,0) S ECXHEAD="TRT",ECXAUD=0 "RTN","ECXATRT",9,0) W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!! "RTN","ECXATRT",10,0) ;select extract "RTN","ECXATRT",11,0) D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD) "RTN","ECXATRT",12,0) Q:ECXERR "RTN","ECXATRT",13,0) ;currently, this extract does not capture divisional data "RTN","ECXATRT",14,0) S ECXALL=1 "RTN","ECXATRT",15,0) D TRT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR) "RTN","ECXATRT",16,0) I ECXERR=1 D Q "RTN","ECXATRT",17,0) .W !!,?5,"Try again later... exiting.",! "RTN","ECXATRT",18,0) .D AUDIT^ECXKILL "RTN","ECXATRT",19,0) ;determine output device and queue if requested "RTN","ECXATRT",20,0) W ! "RTN","ECXATRT",21,0) S ECXPGM="PROCESS^ECXATRT",ECXDESC="TRT Extract Audit Report" "RTN","ECXATRT",22,0) S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")="" "RTN","ECXATRT",23,0) S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q ;149 Section added "RTN","ECXATRT",24,0) .K ^TMP($J,"ECXPORT") "RTN","ECXATRT",25,0) .S ^TMP($J,"ECXPORT",0)="EXTRACT LOG #^DSS SITE^SERVICE^SPECIALTY (DSS CODE)^FACILITY TREATING SPECIALTY^# OF LOSSES",RCNT=1 "RTN","ECXATRT",26,0) .D PROCESS "RTN","ECXATRT",27,0) .D EXPDISP^ECXUTL1 "RTN","ECXATRT",28,0) .D AUDIT^ECXKILL "RTN","ECXATRT",29,0) W ! "RTN","ECXATRT",30,0) D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE) "RTN","ECXATRT",31,0) I ECXSAVE("POP")=1 D Q "RTN","ECXATRT",32,0) .W !!,?5,"Try again later... exiting.",! "RTN","ECXATRT",33,0) .D AUDIT^ECXKILL "RTN","ECXATRT",34,0) I ECXSAVE("ZTSK")=0 D "RTN","ECXATRT",35,0) .K ECXSAVE,ECXPGM,ECXDESC "RTN","ECXATRT",36,0) .D PROCESS^ECXATRT "RTN","ECXATRT",37,0) I IO'=IO(0) D ^%ZISC "RTN","ECXATRT",38,0) D HOME^%ZIS "RTN","ECXATRT",39,0) D AUDIT^ECXKILL "RTN","ECXATRT",40,0) Q "RTN","ECXATRT",41,0) ; "RTN","ECXATRT",42,0) PROCESS ;process data in file #727.817 "RTN","ECXATRT",43,0) N X,Y,W,DATA,DATE,DIV,IEN,TS,SPEC,FTS,FTSNM,SERV,ECX,QQFLG,CNT,A1,A2,NUM,MN,NEWFTS,NEWSPEC "RTN","ECXATRT",44,0) K ^TMP($J,"ECXAUD"),^TMP($J,"ECXSPEC") "RTN","ECXATRT",45,0) S (QQFLG,CNT)=0 "RTN","ECXATRT",46,0) S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF") "RTN","ECXATRT",47,0) S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y "RTN","ECXATRT",48,0) ;get run date in external format "RTN","ECXATRT",49,0) D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y "RTN","ECXATRT",50,0) ;set up the specialty array for site/division "RTN","ECXATRT",51,0) I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q "RTN","ECXATRT",52,0) S DIV="" F S DIV=$O(ECXDIV(DIV)) Q:DIV="" D "RTN","ECXATRT",53,0) .S DIC="^DIC(42.4,",DR=".01;3",DIQ(0)="E",DIQ="ECX" "RTN","ECXATRT",54,0) .S SPEC="" F S SPEC=$O(^DIC(42.4,"B",SPEC)) Q:SPEC="" S TS=$O(^(SPEC,0)) D "RTN","ECXATRT",55,0) ..K ECX S DA=TS D EN^DIQ1 "RTN","ECXATRT",56,0) ..S SPEC=$G(ECX(42.4,TS,.01,"E")),SERV=$G(ECX(42.4,TS,3,"E")) S:SERV="" SERV="Unknown" "RTN","ECXATRT",57,0) ..S ^TMP($J,"ECXSPEC",DIV,TS)=0_U_SERV_U_SPEC,NUM(TS)=0 "RTN","ECXATRT",58,0) ;set up the specialty to facility treating specialty conversion array; "RTN","ECXATRT",59,0) ;determine if active between ecxstart and ecxend; "RTN","ECXATRT",60,0) ;ignore if facility treating specialty not active within date range of report; "RTN","ECXATRT",61,0) S DIC="^DIC(45.7,",DR=".01;1",DIQ(0)="I",DIQ="ECX" "RTN","ECXATRT",62,0) S FTSNM="" F S FTSNM=$O(^DIC(45.7,"B",FTSNM)) Q:FTSNM="" S FTS=$O(^(FTSNM,0)) D "RTN","ECXATRT",63,0) .K ECX S DA=FTS D EN^DIQ1 "RTN","ECXATRT",64,0) .S FTSNM=$G(ECX(45.7,FTS,.01,"I")),TS=$G(ECX(45.7,FTS,1,"I")) "RTN","ECXATRT",65,0) .Q:TS="" "RTN","ECXATRT",66,0) .S A1=$$ACTIVE^DGACT(45.7,FTS,ECXSTART),A2=$$ACTIVE^DGACT(45.7,FTS,ECXEND) "RTN","ECXATRT",67,0) .Q:A1=0&(A2=0) "RTN","ECXATRT",68,0) .;num(ts) will hold the number of active facility treat. specialties (file #45.7) associated "RTN","ECXATRT",69,0) .;with this national specialty (file #42.4). "RTN","ECXATRT",70,0) .I '$D(NUM(TS)) S NUM(TS)=0 "RTN","ECXATRT",71,0) .S ^TMP($J,"ECXTS",TS,FTS)=FTSNM,^TMP($J,"ECXREVTS",FTS)=TS,NUM(TS)=NUM(TS)+1 "RTN","ECXATRT",72,0) ;get extract records in date range "RTN","ECXATRT",73,0) S IEN="" F S IEN=$O(^ECX(727.817,"AC",ECXEXT,IEN)) Q:IEN="" D Q:QQFLG "RTN","ECXATRT",74,0) .S DATA=^ECX(727.817,IEN,0),DATE=$P(DATA,U,9),DIV="" ;169 ,DIV=$P(DATA,U,4) "RTN","ECXATRT",75,0) .;169 4th piece (Facility) is populated starting with patch 169, however, we want all data to be counted in one divisision so it's defaulted to 1 "RTN","ECXATRT",76,0) .S:DIV="" DIV=1 "RTN","ECXATRT",77,0) .;convert free text date to fm internal format date "RTN","ECXATRT",78,0) .S $E(DATE,1,2)=$E(DATE,1,2)-17 "RTN","ECXATRT",79,0) .Q:$L(DATE)<7 Q:(DATEECXEND) "RTN","ECXATRT",80,0) .I $D(ECXDIV(DIV)) D "RTN","ECXATRT",81,0) ..;ts is the old specialty, newfts is the new facility treat. spec. for the movement date; "RTN","ECXATRT",82,0) ..;after patch #1 'losing treating specialty los' field (#17) is non-null only for actual specialty changes; "RTN","ECXATRT",83,0) ..;so should be able to distinguish true ts changes from provider-only changes; "RTN","ECXATRT",84,0) ..;although it will still be possible that old and new specialty are the same, but facility "RTN","ECXATRT",85,0) ..;treat. spec. was changed, but we've lost that info in the extract. "RTN","ECXATRT",86,0) ..; "RTN","ECXATRT",87,0) ..;filter out those records which are definitely provider-only changes; "RTN","ECXATRT",88,0) ..;these are the records that have 'losing treating specialty los' which is null; "RTN","ECXATRT",89,0) ..;but for extracts done prior to patch #1, still need to compare old & new specialty. "RTN","ECXATRT",90,0) ..; "RTN","ECXATRT",91,0) ..;convert 15th and 16th piece from PTF code back to Specialty "RTN","ECXATRT",92,0) ..;ECX*3.0*107 "RTN","ECXATRT",93,0) ..; "RTN","ECXATRT",94,0) ..N ECXTS,NEWTS "RTN","ECXATRT",95,0) ..S ECXTS=$P(DATA,U,15) I ECXTS'="" S ECXTS=$O(^DIC(42.4,"C",$G(ECXTS),0)),$P(DATA,U,15)=ECXTS "RTN","ECXATRT",96,0) ..S ECXTS=$P(DATA,U,16) I ECXTS'="" S ECXTS=$O(^DIC(42.4,"C",$G(ECXTS),0)),$P(DATA,U,16)=ECXTS "RTN","ECXATRT",97,0) ..S NEWTS=$P(DATA,U,15),TS=$P(DATA,U,16),LOS=$P(DATA,U,17) "RTN","ECXATRT",98,0) ..;leaving this next line in here for v3.0 extracts done prior to patch #1 "RTN","ECXATRT",99,0) ..Q:(NUM(+TS)=1)&(NEWTS=TS) "RTN","ECXATRT",100,0) ..Q:LOS="" "RTN","ECXATRT",101,0) ..S $P(^(TS),U,1)=$P(^TMP($J,"ECXSPEC",DIV,TS),U,1)+1,CNT=CNT+1 "RTN","ECXATRT",102,0) ..I $D(ZTQUEUED),(CNT>499),'(CNT#500),$$S^%ZTLOAD S QQFLG=1,ZTSTOP=1 K ZTREQ "RTN","ECXATRT",103,0) ;after all extract records processed, arrange by service and specialty; "RTN","ECXATRT",104,0) ;total can only be associated with specialty, not facility treating specialty; "RTN","ECXATRT",105,0) ;include specialty only if total loss is non-zero "RTN","ECXATRT",106,0) I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q "RTN","ECXATRT",107,0) S DIV="" F S DIV=$O(ECXDIV(DIV)) Q:DIV="" I $D(^TMP($J,"ECXSPEC",DIV)) D "RTN","ECXATRT",108,0) .S TS="" F S TS=$O(^TMP($J,"ECXSPEC",DIV,TS)) Q:TS="" D "RTN","ECXATRT",109,0) ..S TOT=+$P(^TMP($J,"ECXSPEC",DIV,TS),U,1) I TOT>0 D "RTN","ECXATRT",110,0) ...S SERV=$P(^(TS),U,2),SPEC=$P(^(TS),U,3) "RTN","ECXATRT",111,0) ...S ^TMP($J,"ECXAUD",DIV,SERV,SPEC)=TOT_U_TS "RTN","ECXATRT",112,0) ;print the report "RTN","ECXATRT",113,0) D PRINT "RTN","ECXATRT",114,0) I $G(ECXPORT) Q ;149 "RTN","ECXATRT",115,0) D AUDIT^ECXKILL "RTN","ECXATRT",116,0) Q "RTN","ECXATRT",117,0) ; "RTN","ECXATRT",118,0) PRINT ;print trt data by site, by service, by specialty "RTN","ECXATRT",119,0) N JJ,SS,LN,P,DIV,DIVNM,GTOT,SVCTOT,PG,QFLG,DIR,DIRUT,DTOUT,DUOUT,FIRST ;149 "RTN","ECXATRT",120,0) U IO "RTN","ECXATRT",121,0) I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q "RTN","ECXATRT",122,0) S (QFLG,PG)=0,$P(LN,"-",80)="" "RTN","ECXATRT",123,0) ;division associated with the treat. spec. change is not actually known; division is dss site "RTN","ECXATRT",124,0) S DIV="" S DIV=$O(ECXDIV(DIV)) Q:DIV="" S GTOT=0 "RTN","ECXATRT",125,0) I '$G(ECXPORT) D HEADER ;149 "RTN","ECXATRT",126,0) I '$D(^TMP($J,"ECXAUD",DIV)) D Q "RTN","ECXATRT",127,0) .I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=ECXEXT_U_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")"_U_"No data available for this DSS Site",RCNT=RCNT+1 Q ;149 "RTN","ECXATRT",128,0) .W !!,?5,"No data available for this DSS Site.",!! "RTN","ECXATRT",129,0) I $D(^TMP($J,"ECXAUD",DIV)) S SERV="" F S SERV=$O(^TMP($J,"ECXAUD",DIV,SERV)) Q:SERV="" D Q:QFLG "RTN","ECXATRT",130,0) .S SVCTOT=0 "RTN","ECXATRT",131,0) .;write the service name "RTN","ECXATRT",132,0) .I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG W !,SERV ;149 "RTN","ECXATRT",133,0) .S SPEC="" F S SPEC=$O(^TMP($J,"ECXAUD",DIV,SERV,SPEC)) Q:SPEC="" D Q:QFLG "RTN","ECXATRT",134,0) ..;write the specialty name and total "RTN","ECXATRT",135,0) ..S TOT=$P(^TMP($J,"ECXAUD",DIV,SERV,SPEC),U,1),TS=$P(^(SPEC),U,2) "RTN","ECXATRT",136,0) ..I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=ECXEXT_U_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")"_U_SERV_U_SPEC_" ("_TS_")"_"^^"_TOT,RCNT=RCNT+1 ;149 "RTN","ECXATRT",137,0) ..I '$G(ECXPORT) W ?22,$E(SPEC,1,30)_" ("_TS_")",?68,$$RJ^XLFSTR(TOT,5," "),! ;149 "RTN","ECXATRT",138,0) ..S SVCTOT=SVCTOT+TOT,GTOT=GTOT+TOT "RTN","ECXATRT",139,0) ..S FIRST=1 ;149 "RTN","ECXATRT",140,0) ..S FTS="" F S FTS=$O(^TMP($J,"ECXTS",TS,FTS)) Q:FTS="" D Q:QFLG "RTN","ECXATRT",141,0) ...S FTSNM=^TMP($J,"ECXTS",TS,FTS) "RTN","ECXATRT",142,0) ...I $G(ECXPORT),FIRST S $P(^TMP($J,"ECXPORT",(RCNT-1)),U,5)=FTSNM,FIRST=0 Q ;149 For first treating specialty, put it on same line as the "total" line "RTN","ECXATRT",143,0) ...I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=ECXEXT_U_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")"_U_SERV_U_SPEC_" ("_TS_")"_U_FTSNM,RCNT=RCNT+1 Q ;149 "RTN","ECXATRT",144,0) ...D:($Y+3>IOSL) HEADER Q:QFLG W ?25,$E(FTSNM,1,30),! "RTN","ECXATRT",145,0) .;write the service subtotal "RTN","ECXATRT",146,0) .Q:QFLG "RTN","ECXATRT",147,0) .I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^^Total for "_SERV_"^^^"_SVCTOT,RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1 Q ;149 "RTN","ECXATRT",148,0) .W ?22,$E(LN,1,54),! "RTN","ECXATRT",149,0) .D:($Y+3>IOSL) HEADER Q:QFLG W "Total for "_SERV_":",?68,$$RJ^XLFSTR(SVCTOT,5," "),! "RTN","ECXATRT",150,0) ;write the grandtotal for all services at facility "RTN","ECXATRT",151,0) I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)="^^Grand Total for all Services^^^"_GTOT Q ;149 "RTN","ECXATRT",152,0) D:($Y+3>IOSL) HEADER Q:QFLG W !!,"Grand Total for all Services:",?68,$$RJ^XLFSTR(GTOT,5," ") "RTN","ECXATRT",153,0) ;print the audit descriptive narrative "RTN","ECXATRT",154,0) I $E(IOST)'="C" D "RTN","ECXATRT",155,0) .W @IOF S PG=PG+1 "RTN","ECXATRT",156,0) .W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report" "RTN","ECXATRT",157,0) .W !,"DSS Extract Log #: "_ECXEXT "RTN","ECXATRT",158,0) .W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END") "RTN","ECXATRT",159,0) .W !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG "RTN","ECXATRT",160,0) .W !!,LN,!! "RTN","ECXATRT",161,0) .S DIC="^ECX(727.1,",DA=ECXARRAY("DEF"),DR="1" D EN^DIQ "RTN","ECXATRT",162,0) I $E(IOST)="C",'QFLG D "RTN","ECXATRT",163,0) .S SS=22-$Y F JJ=1:1:SS W ! "RTN","ECXATRT",164,0) .S DIR(0)="E" W ! D ^DIR K DIR "RTN","ECXATRT",165,0) Q "RTN","ECXATRT",166,0) ; "RTN","ECXATRT",167,0) HEADER ;header and page control "RTN","ECXATRT",168,0) N JJ,SS "RTN","ECXATRT",169,0) I $E(IOST)="C",'QFLG D ;149 Quit if user entered "^" "RTN","ECXATRT",170,0) .S SS=22-$Y F JJ=1:1:SS W ! "RTN","ECXATRT",171,0) .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1 "RTN","ECXATRT",172,0) Q:QFLG "RTN","ECXATRT",173,0) W:$Y!($E(IOST)="C") @IOF S PG=PG+1 "RTN","ECXATRT",174,0) ;W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report" "RTN","ECXATRT",175,0) W !,"Treating Specialty Change"_" ("_ECXHEAD_") Extract Audit Report" "RTN","ECXATRT",176,0) W !,"DSS Extract Log #: "_ECXARRAY("EXTRACT") "RTN","ECXATRT",177,0) W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END") "RTN","ECXATRT",178,0) W !,"Report Run Date/Time: "_ECXRUN "RTN","ECXATRT",179,0) W !,"DSS Site: "_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")",?68,"Page: "_PG "RTN","ECXATRT",180,0) W !!,"Service",?22,"Specialty (DSS Code)",?68,"# of Losses" "RTN","ECXATRT",181,0) W !,?25,"Facility Treating Specialty" "RTN","ECXATRT",182,0) W !,LN,! "RTN","ECXATRT",183,0) Q "RTN","ECXPRO") 0^2^B51537210^B51138960 "RTN","ECXPRO",1,0) ECXPRO ;ALB/GTS - Prosthetics Extract for DSS ;11/8/17 14:51 "RTN","ECXPRO",2,0) ;;3.0;DSS EXTRACTS;**9,13,15,21,24,33,39,46,71,92,105,120,127,132,136,144,149,154,161,166,169**;Dec 22, 1997;Build 2 "RTN","ECXPRO",3,0) BEG ;entry point from option "RTN","ECXPRO",4,0) D SETUP I ECFILE="" Q "RTN","ECXPRO",5,0) D:+ECINST>0 ^ECXTRAC D ^ECXKILL "RTN","ECXPRO",6,0) Q "RTN","ECXPRO",7,0) ; "RTN","ECXPRO",8,0) START ;start package specific extract "RTN","ECXPRO",9,0) ; "RTN","ECXPRO",10,0) ; Input "RTN","ECXPRO",11,0) ; ECSD1 - FM formatted Beginning Date (Set by ECXTRAC) "RTN","ECXPRO",12,0) ; ECED - FM formatted End Date (Set by ECXTRAC) "RTN","ECXPRO",13,0) ; ECSDN - Externally formatted Start Date (Set by ECXTRAC) "RTN","ECXPRO",14,0) ; ECEDN - Externally formatted End Date (Set by ECXTRAC) "RTN","ECXPRO",15,0) ; EC - IEN from file #727 (Set by ECXTRAC) "RTN","ECXPRO",16,0) ; ECXYM - Year and Month of extract (YYYYMM) "RTN","ECXPRO",17,0) ; ECXINST - IEN for division in file #4 "RTN","ECXPRO",18,0) ; ECINST - Station number of selected division "RTN","ECXPRO",19,0) ; "RTN","ECXPRO",20,0) N ECXLNE,ECXCT,ECXDACT,ECX0,ECXLB,ECXED1,ECINSTSV,ECXLNSTR,ECXP "RTN","ECXPRO",21,0) N ECXICD10P,ECXICD101,ECXICD102,ECXICD103,ECXICD104 "RTN","ECXPRO",22,0) N DIC,DR,DA,DIQ,CPTCODE,ECXNPRFI "RTN","ECXPRO",23,0) N ECXESC,ECXCLST,ECXECL,ECXUI ;144,166 "RTN","ECXPRO",24,0) D ECXBUL^ECXPRO2(.ECXLNE,ECSDN,ECEDN,EC) "RTN","ECXPRO",25,0) S QFLG=0,ECXLNSTR=ECXLNE,ECXED1=ECED+.9999,ECXCT=ECSD1 "RTN","ECXPRO",26,0) F S ECXCT=$O(^RMPR(660,"CT",ECXCT)) Q:(ECXCT>ECXED1)!('ECXCT)!(QFLG=1) D "RTN","ECXPRO",27,0) .S ECXDACT=0 "RTN","ECXPRO",28,0) .F S ECXDACT=$O(^RMPR(660,"CT",ECXCT,ECXDACT)) Q:('ECXDACT)!(QFLG=1) D "RTN","ECXPRO",29,0) ..;* initialize variables "RTN","ECXPRO",30,0) ..S (ECXDFN,ECXPNM,ECXSSN,ECXSEX,ECXSTAT,ECXDATE,ECXTYPE,ECXSRCE)="" "RTN","ECXPRO",31,0) ..S (ECXHCPCS,ECXPHCPC,ECXRQST,ECXRCST,ECXFORM,ECXCTAMT,ECXLLC)="" "RTN","ECXPRO",32,0) ..S (ECXLMC,ECXGRPR,ECXBILST,ECXQTY,ECXFELOC,ECXFEKEY,ECXA,ECXLH,ECXLC,ECXMC)="" "RTN","ECXPRO",33,0) ..S (ECPTTM,ECPTPR,ECXAST,ECXRST,ECXEST,ECXELIG,ECXVET,ECXZIP,ECXVNS,ECXCLST)="" ;144 "RTN","ECXPRO",34,0) ..S (ECXDOB,ECXDSSD,ECXICD9,ECXICD10P,ECXAOL,ECXHNCI,ECXSHADI,ECXETH,ECXRC1,ECXMST)="" "RTN","ECXPRO",35,0) ..F I=1:1:4 S @("ECXICD9"_I)="" "RTN","ECXPRO",36,0) ..F I=1:1:4 S @("ECXICD10"_I)="" "RTN","ECXPRO",37,0) ..Q:'$D(^RMPR(660,ECXDACT,0)) "RTN","ECXPRO",38,0) ..S ECX0=^RMPR(660,ECXDACT,0),ECXLB=$G(^RMPR(660,ECXDACT,"LB")) "RTN","ECXPRO",39,0) ..K ECXP S DIC="^RMPR(660,",DR=".02;11;45",DA=ECXDACT,DIQ(0)="EI" "RTN","ECXPRO",40,0) ..S DIQ="ECXP" D EN^DIQ1 "RTN","ECXPRO",41,0) ..S ECXDIV=$$GET1^DIQ(660,ECXDACT,8,"I") "RTN","ECXPRO",42,0) ..S ECXDFN=$G(ECXP(660,ECXDACT,.02,"I")) "RTN","ECXPRO",43,0) ..S ECXFORM=$G(ECXP(660,ECXDACT,11,"E"))_U_$G(ECXP(660,ECXDACT,11,"I")) "RTN","ECXPRO",44,0) ..S ECXLH=$G(ECXP(660,ECXDACT,45,"I")) "RTN","ECXPRO",45,0) ..S ECXUI=$$GET1^DIQ(660,ECXDACT,78) ;166 get unit of issue "RTN","ECXPRO",46,0) ..Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXCT) "RTN","ECXPRO",47,0) ..S OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;5",.ECXPAT) "RTN","ECXPRO",48,0) ..I 'OK S ECXERR=1 K ECXPAT Q "RTN","ECXPRO",49,0) ..;OEF/OIF data "RTN","ECXPRO",50,0) ..S ECXOEF=ECXPAT("ECXOEF") "RTN","ECXPRO",51,0) ..S ECXOEFDT=ECXPAT("ECXOEFDT") "RTN","ECXPRO",52,0) ..S ECXVNS=ECXPAT("VIETNAM") ; 144 VIETNAM STATUS "RTN","ECXPRO",53,0) ..S ECXCLST=ECXPAT("CL STAT") ;144 Camp Lejeune Status "RTN","ECXPRO",54,0) ..S ECXSVCI=ECXPAT("COMBSVCI") ;149 COMBAT SVC IND "RTN","ECXPRO",55,0) ..S ECXSVCL=ECXPAT("COMBSVCL") ;149 COMBAT SVC LOC "RTN","ECXPRO",56,0) ..Q:'$$NTEG^ECXPRO1(ECXDFN,.ECXLNE,ECXDACT,ECX0,ECXLB,ECINST,ECXFORM) "RTN","ECXPRO",57,0) ..D PROSINFO^ECXPRO1(ECXDACT,ECXLB,ECX0,ECXFORM) "RTN","ECXPRO",58,0) ..S CPTCODE=$E(ECXHCPCS,1,5) "RTN","ECXPRO",59,0) ..;nppd entry date "RTN","ECXPRO",60,0) ..S ECXNPPDT=$$ECXDATE^ECXUTL($P(ECX0,U,1),ECXYM) "RTN","ECXPRO",61,0) ..; "RTN","ECXPRO",62,0) ..;Get production division ;p-46 "RTN","ECXPRO",63,0) ..N ECXPDIV S ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV) ;p-46 "RTN","ECXPRO",64,0) ..;- Observation patient indicator (YES/NO) "RTN","ECXPRO",65,0) ..S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS) "RTN","ECXPRO",66,0) ..; "RTN","ECXPRO",67,0) ..;- CNH status (YES/NO) "RTN","ECXPRO",68,0) ..S ECXCNH=$$CNHSTAT^ECXUTL4(ECXDFN) "RTN","ECXPRO",69,0) ..; "RTN","ECXPRO",70,0) ..;get encounter classifications "RTN","ECXPRO",71,0) ..S (ECXAO,ECXECE,ECXHNC,ECXMIL,ECXIR,ECXSHAD,ECXESC,ECXECL)="" ;144 "RTN","ECXPRO",72,0) ..S ECXVISIT=$$GET1^DIQ(660,ECXDACT,8.12,"I") I ECXVISIT'="" D "RTN","ECXPRO",73,0) ...D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR Q "RTN","ECXPRO",74,0) ...S ECXAO=$G(ECXVIST("AO")),ECXECE=$G(ECXVIST("PGE")),ECXSHAD=$G(ECXVIST("SHAD")) "RTN","ECXPRO",75,0) ...S ECXHNC=$G(ECXVIST("HNC")),ECXMIL=$G(ECXVIST("MST")),ECXIR=$G(ECXVIST("IR")) "RTN","ECXPRO",76,0) ...S ECXESC=ECXVIST("ENCSC"),ECXECL=ECXVIST("ENCCL") ;144 "RTN","ECXPRO",77,0) ..; - Head and Neck Cancer Indicator "RTN","ECXPRO",78,0) ..S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) "RTN","ECXPRO",79,0) ..; "RTN","ECXPRO",80,0) ..; - Proj 112/SHAD Indicator "RTN","ECXPRO",81,0) ..S ECXSHADI=$$SHAD^ECXUTL4(ECXDFN) "RTN","ECXPRO",82,0) ..; "RTN","ECXPRO",83,0) ..; ******* - PATCH 127, ADD PATCAT CODE ******** "RTN","ECXPRO",84,0) ..S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN) "RTN","ECXPRO",85,0) ..; - set national patient record flag if exist "RTN","ECXPRO",86,0) ..D NPRF^ECXUTL5 "RTN","ECXPRO",87,0) ..; "RTN","ECXPRO",88,0) ..;- If no encounter number don't file record "RTN","ECXPRO",89,0) ..S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,,) Q:ECXENC="" "RTN","ECXPRO",90,0) ..I ECXFORM["-3" F ECXLAB="LAB","ORD" D "RTN","ECXPRO",91,0) ...S ECINSTSV=ECXRQST I ECINSTSV="" S ECINSTSV=ECXPDIV ;166,169 tjl "RTN","ECXPRO",92,0) ...D FEEDINFO^ECXPRO2(ECXSRCE,CPTCODE,ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC) "RTN","ECXPRO",93,0) ...Q:ECXFELOC="" D FILE "RTN","ECXPRO",94,0) ..I ECXFORM'["-3" S ECXLAB="NONL" D "RTN","ECXPRO",95,0) ...S ECINSTSV=ECXSTAT2 I ECINSTSV="" S ECINSTSV=ECXPDIV ;166,169 tjl "RTN","ECXPRO",96,0) ...D FEEDINFO^ECXPRO2(ECXSRCE,CPTCODE,ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC) "RTN","ECXPRO",97,0) ...Q:ECXFELOC="" D FILE "RTN","ECXPRO",98,0) ;* Send the Exception message "RTN","ECXPRO",99,0) I ECXLNSTR2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI "RTN","ECXPRO",165,0) I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U "RTN","ECXPRO",166,0) I ECXLOGIC>2007 S ECODE2=ECXOEF_U_ECXOEFDT_U_ECXNPPDC_U_ECXNPPDT_U_ECASNPI_U_ECPTNPI "RTN","ECXPRO",167,0) I ECXLOGIC>2009 S ECODE2=ECODE2_U_ECXCNTRY "RTN","ECXPRO",168,0) I ECXLOGIC>2010 S ECODE2=ECODE2_U_ECXSHADI_U_ECXSHAD_U_ECXLH_U_ECXPATCAT "RTN","ECXPRO",169,0) I ECXLOGIC>2012 S ECODE2=ECODE2_U_ECXICD10P_U_ECXICD101_U_ECXICD102_U_ECXICD103_U_ECXICD104 "RTN","ECXPRO",170,0) I ECXLOGIC>2013 S ECODE2=ECODE2_U_ECXESC_U_ECXVNS_U_ECXCLST_U_ECXECL ;144 "RTN","ECXPRO",171,0) I ECXLOGIC>2014 S ECODE2=ECODE2_U_ECXSVCI_U_ECXSVCL ;149 "RTN","ECXPRO",172,0) I ECXLOGIC>2015 S ECODE2=ECODE2_U_$P(ECXFORM,U,2) ;154 "RTN","ECXPRO",173,0) I ECXLOGIC>2017 S ECODE2=ECODE2_U_$G(ECXUI) ;166 "RTN","ECXPRO",174,0) S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1 "RTN","ECXPRO",175,0) S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA "RTN","ECXPRO",176,0) I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 "RTN","ECXPRO",177,0) Q "RTN","ECXPRO",178,0) ; "RTN","ECXPRO",179,0) SETUP ;Set required input for ECXTRAC "RTN","ECXPRO",180,0) S ECHEAD="PRO" "RTN","ECXPRO",181,0) D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) "RTN","ECXPRO",182,0) S ECINST=$$PDIV^ECXPUTL "RTN","ECXPRO",183,0) Q "RTN","ECXPRO",184,0) ; "RTN","ECXPRO",185,0) ;**Note: LOCAL and QUE are carry over from protocols set by other "RTN","ECXPRO",186,0) ; routines. "RTN","ECXPRO",187,0) LOCAL ;to extract nightly for local use not to be transmitted to TSI "RTN","ECXPRO",188,0) ;QUEUE with 1D frequency "RTN","ECXPRO",189,0) D SETUP,^ECXTLOCL,^ECXKILL Q "RTN","ECXPRO",190,0) ; "RTN","ECXPRO",191,0) QUE ; entry point for the background requeuing handled by ECXTAUTO "RTN","ECXPRO",192,0) D SETUP,QUE^ECXTAUTO,^ECXKILL Q "RTN","ECXWRD") 0^1^B18988653^B18988653 "RTN","ECXWRD",1,0) ECXWRD ;BIR/CML,ALB/JAP Print Active Wards for Fiscal Year ;11/8/17 14:59 "RTN","ECXWRD",2,0) ;;3.0;DSS EXTRACTS;**2,8,127,149,166,169**;Dec 22, 1997;Build 2 "RTN","ECXWRD",3,0) ; "RTN","ECXWRD",4,0) EN ;entry point from option "RTN","ECXWRD",5,0) N DATE,YR,MON,FY,POP,ZTSK,ECXPORT,CNT ;149 "RTN","ECXWRD",6,0) D NOW^%DTC S DATE=$$FMTE^XLFDT(%,"5D"),YR=+$P(DATE,"/",3),MON=+$P(DATE,"/",1),FY=$S(MON<10:YR,1:YR+1) "RTN","ECXWRD",7,0) W !!,"This option prints a list of all MAS/HAS wards that were active at any time" "RTN","ECXWRD",8,0) W !,"during FY",FY,". The list is sorted by Medical Center Division and displays" "RTN","ECXWRD",9,0) W !,"the pointer to the Hospital Location file (#44) and DSS Department data" "RTN","ECXWRD",10,0) W !,"if available." "RTN","ECXWRD",11,0) S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 ;149 "RTN","ECXWRD",12,0) I ECXPORT D Q ;149 Section added "RTN","ECXWRD",13,0) .K ^TMP($J) "RTN","ECXWRD",14,0) .S ^TMP($J,"ECXPORT",0)="DIVISION^WARD^DSS DEPT^POINTER TO FILE 44^WARD SERVICE^WARD SPECIALTY",CNT=1 "RTN","ECXWRD",15,0) .D START "RTN","ECXWRD",16,0) .D EXPDISP^ECXUTL1 "RTN","ECXWRD",17,0) .K ^TMP($J),^TMP("ECXWRD",$J) "RTN","ECXWRD",18,0) W !!,"This report requires a print width of 132 characters.",!! "RTN","ECXWRD",19,0) S ECXPGM="START^ECXWRD",ECXDESC="DSS-Print Active Wards for Fiscal Year",ECXSAVE("FY")="" "RTN","ECXWRD",20,0) W ! D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE) "RTN","ECXWRD",21,0) I ECXSAVE("POP")=1 D Q "RTN","ECXWRD",22,0) .W !,"No device selected... try again later.!!" "RTN","ECXWRD",23,0) I ECXSAVE("ZTSK")=0 U IO D START^ECXWRD "RTN","ECXWRD",24,0) I IO'=IO(0) D ^%ZISC "RTN","ECXWRD",25,0) D HOME^%ZIS "RTN","ECXWRD",26,0) K ECXSAVE,ECXPGM,ECXDESC "RTN","ECXWRD",27,0) K ECXDIVN,ECFYB,ECFYE,ECXWD,ECXWDN,ECXDEPT,ECXDESC,FY,^TMP("ECXWRD",$J) "RTN","ECXWRD",28,0) Q "RTN","ECXWRD",29,0) START ; "RTN","ECXWRD",30,0) N QFLG,%,%H,%I,JJ,SS,HDT,DATA,ECXFY,EC,DR,DIQ,DA,DIC,ECX,PG,LN,Y ;149 adding vars to new line "RTN","ECXWRD",31,0) K ^TMP("ECXWRD",$J) "RTN","ECXWRD",32,0) S ECXFY=FY-1700 "RTN","ECXWRD",33,0) S ECFYB=ECXFY-1_"1000",ECFYE=ECXFY_"1001" "RTN","ECXWRD",34,0) ;gather data "RTN","ECXWRD",35,0) S ECXWD=0 "RTN","ECXWRD",36,0) F S ECXWD=$O(^DIC(42,ECXWD)) Q:'ECXWD I $D(^DIC(42,ECXWD,0)) D "RTN","ECXWRD",37,0) .S EC=^DIC(42,ECXWD,0) D CHK Q:X=1 "RTN","ECXWRD",38,0) .S DR=".01;.03;.015;.017;44",DIQ(0)="IE",DIQ="ECX",DA=ECXWD,DIC="^DIC(42," K ECX D EN^DIQ1 "RTN","ECXWRD",39,0) .S ECXWDN=$G(ECX(42,ECXWD,.01,"E")) "RTN","ECXWRD",40,0) .S ECXDIVN=$G(ECX(42,ECXWD,.015,"E")) S:ECXDIVN="" ECXDIVN="UNKNOWN" "RTN","ECXWRD",41,0) .S ^TMP("ECXWRD",$J,ECXDIVN,ECXWDN)=$G(ECX(42,ECXWD,44,"I"))_U_$G(ECX(42,ECXWD,.03,"E"))_U_$G(ECX(42,ECXWD,.017,"E"))_U "RTN","ECXWRD",42,0) .I $D(^ECX(727.4,ECXWD)) D "RTN","ECXWRD",43,0) ..S ECXDEPT=$P(^ECX(727.4,ECXWD,0),U,2) Q:ECXDEPT="" "RTN","ECXWRD",44,0) ..D REVERSE^ECXDSSD(ECXDEPT,.ECXDESC) "RTN","ECXWRD",45,0) ..S ^TMP("ECXWRD",$J,ECXDIVN,ECXWDN)=^TMP("ECXWRD",$J,ECXDIVN,ECXWDN)_ECXDEPT_U_ECXDESC "RTN","ECXWRD",46,0) ;print the report "RTN","ECXWRD",47,0) S (PG,QFLG)=0,$P(LN,"-",130)="" D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S HDT=Y "RTN","ECXWRD",48,0) I '$G(ECXPORT) D HDR ;149 "RTN","ECXWRD",49,0) I '$G(ECXPORT) I '$D(^TMP("ECXWRD",$J)) W !!,"NO DATA FOUND FOR THIS REPORT" Q ;149 "RTN","ECXWRD",50,0) S ECXDIVN="" "RTN","ECXWRD",51,0) F S ECXDIVN=$O(^TMP("ECXWRD",$J,ECXDIVN)) Q:ECXDIVN="" Q:QFLG D "RTN","ECXWRD",52,0) .I '$G(ECXPORT) D:$Y+4>IOSL HDR Q:QFLG ;149 "RTN","ECXWRD",53,0) .W:'$G(ECXPORT) !!,"DIVISION: ",ECXDIVN S ECXWDN="" D ;149 "RTN","ECXWRD",54,0) ..F S ECXWDN=$O(^TMP("ECXWRD",$J,ECXDIVN,ECXWDN)) Q:ECXWDN="" Q:QFLG D "RTN","ECXWRD",55,0) ...S DATA=^TMP("ECXWRD",$J,ECXDIVN,ECXWDN),ECXDEPT=$P(DATA,U,4) "RTN","ECXWRD",56,0) ...I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=ECXDIVN_U_ECXWDN_U_ECXDEPT_U_$P(DATA,U,1,3),CNT=CNT+1 Q ;149 "RTN","ECXWRD",57,0) ...D:$Y+4>IOSL HDR Q:QFLG W !?5,$E(ECXWDN,1,20),?30,ECXDEPT,?45,$P(DATA,U,1),?60,$E($P(DATA,U,2),1,18),?80,$P(DATA,U,3) "RTN","ECXWRD",58,0) ...Q:ECXDEPT="" "RTN","ECXWRD",59,0) ...I '$G(ECXPORT) D:$Y+4>IOSL HDR Q:QFLG ;149 "RTN","ECXWRD",60,0) ...;W !?30,"[Svc: "_$E($P(DATA,U,5),1,20)_" "_"Prod. Unit: "_$E($P(DATA,U,6),1,40)_" "_"Div: "_$P(DATA,U,7)_"]",! "RTN","ECXWRD",61,0) I '$G(ECXPORT) I $E(IOST)="C"&('QFLG) S DIR(0)="E" D D ^DIR K DIR ;149 "RTN","ECXWRD",62,0) .S SS=22-$Y F JJ=1:1:SS W ! "RTN","ECXWRD",63,0) I '$G(ECXPORT) W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" ;149 "RTN","ECXWRD",64,0) K ECXDIVN,ECFYB,ECFYE,ECXWD,ECXWDN,ECXDEPT,ECXDESC,FY,^TMP("ECXWRD",$J) "RTN","ECXWRD",65,0) Q "RTN","ECXWRD",66,0) ; "RTN","ECXWRD",67,0) CHK ;has this ward been active? "RTN","ECXWRD",68,0) ; output "RTN","ECXWRD",69,0) ; X = 1 if inactive (out-of-service), 0 otherwise "RTN","ECXWRD",70,0) ; "RTN","ECXWRD",71,0) N ECX,ECY "RTN","ECXWRD",72,0) S X=1 Q:'$D(ECXWD) S ECY=ECFYB "RTN","ECXWRD",73,0) I '$O(^DIC(42,ECXWD,"OOS",0)) S X=0 Q "RTN","ECXWRD",74,0) S ECX=+$O(^DIC(42,ECXWD,"OOS","AINV",9999998.9-ECY)),ECX=$S($D(^DIC(42,ECXWD,"OOS",+$O(^(+ECX,0)),0)):^(0),1:"") "RTN","ECXWRD",75,0) I '$P(ECX,U,6) S X=0 Q "RTN","ECXWRD",76,0) I $P(ECX,U,6),'$P(ECX,U,4) S X=1 Q "RTN","ECXWRD",77,0) I $P(ECX,U,6),$P(ECX,U,4)0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q "RTN","ECXWRD",84,0) S PG=PG+1 W:$Y!($E(IOST)="C") @IOF W !,"Active Wards for FY",FY,!,"Printed on ",HDT,! "RTN","ECXWRD",85,0) W !?30,"DSS",?45,"Pointer",?60,"Ward",?80,"Ward" "RTN","ECXWRD",86,0) W !?5,"WARD",?30,"Department",?45,"to File #44",?60,"Service",?80,"Specialty" "RTN","ECXWRD",87,0) W !,LN "RTN","ECXWRD",88,0) Q "VER") 8.0^22.2 "BLD",10322,6) ^151 **END** **END**