Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXPROCT

ECXPROCT.m

Go to the documentation of this file. 
  1. ECXPROCT ;ALB/GTS - ProstheticS Cost by PSAS HCPC Report DSS ;4/27/16  16:31
  1.  ;;3.0;DSS EXTRACTS;**71,100,144,154,161**;Dec 22, 1997;Build 6
  1.  ;
  1. EN ;entry point from option
  1.  ;Initialize varables
  1.  N DIR,ECSD1,ECED,X,Y,ECXPORT,I ;144
  1.  ;Prompt for start date
  1.  S DIR(0)="D^::EX"
  1.  S DIR("A")="Enter Report Start Date"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  S ECSD1=Y
  1.  ;Prompt for end date
  1.  K DIR,X,Y
  1.  S DIR(0)="D^"_ECSD1_":"_DT_":EX"
  1.  S DIR("A")="Enter Report Ending Date"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  S ECED=Y
  1.  S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1  I ECXPORT D  Q  ;144
  1.  .K ^TMP($J,"ECXPORT") ;144
  1.  .S ^TMP($J,"ECXPORT",0)="PSAS HCPC^FEEDER KEY^DESCRIPTION^FORM^FORM DESCRIPTION^QTY^UNIT OF ISSUE^COST" ;144,154,161
  1.  .D EN1 ;144
  1.  .M ^TMP($J,"ECXPORT")=^TMP("ECXDSS",$J) ;144 Move results to export display global
  1.  .D EXPDISP^ECXUTL1 ;144
  1.  ;Queue Report
  1.  W !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **",!!
  1.  N ZTDESC,ZTIO,ZTSAVE
  1.  S ZTIO=""
  1.  S ZTDESC="Prosthetic Cost by PSAS HCPC Report for DSS"
  1.  F I="ECSD1","ECED","ECXPHCPC","ECXPHDESC","ECXHCPC","ECXQTY","ECXUOFI","ECXCOST","ECXTCOST" D
  1.  .S ZTSAVE(I)=""
  1.  D EN^XUTMDEVQ("EN1^ECXPROCT",ZTDESC,.ZTSAVE)
  1.  Q
  1.  ;
  1. EN1 ;Tasked entry point
  1.  ;Input : ECSD1  -  FM format report start date
  1.  ;        ECED   -  FM format report end date
  1.  ;
  1.  ;Output : None
  1.  ;
  1.  ;Declare variables
  1.  N ECXPHCPC,ECHCDES,ECXHCPC,ECXQTY,ECXUOFI,ECXCOST,ECXTCOST,PAGENUM ;144
  1.  N ECXLNE,ECXCT,ECXDACT,ECX0,ECX1,ECXED1,ECINSTSV,ECXLNSTR,ECXP
  1.  N DIC,DR,DA,DIQ,CNT,STOP,QFLG,ECXDIV,ECXDFN,ECXFORM ;144
  1.  K ^TMP("ECXDSS",$J) ;161
  1.  S ECXED1=ECED+.9999,ECXCT=ECSD1-.1,(CNT,QFLG,PAGENUM,ECXTCOST,ECXQTY,STOP)=0 ;154 Changed start date to begin before selected date so records on the date are found
  1.  S ECXLNE=1 ;161
  1.  I '$G(ECXPORT) D HEADER I STOP D EXIT Q  ;144
  1.  D GETDATA I $G(ECXPORT) Q  ;144 Have data, no need to print.
  1.  I '$D(^TMP("ECXDSS",$J)) D  Q
  1.  .W !
  1.  .W !,"***********************************************"
  1.  .W !,"*  NOTHING TO REPORT FOR SELECTED TIME FRAME  *"
  1.  .W !,"***********************************************"
  1.  .D WAIT
  1.  D DETAIL I STOP D EXIT Q
  1.  D TOTAL
  1.  D FOOTER ;154
  1.  K ^TMP("ECXDSS",$J)
  1.  Q
  1.  ;
  1. GETDATA ;Get data
  1.  N ECXFELOC,ECXFEKEY,ECXLB,ECINST,ECXLAB,ECX15KEY,RES ;161
  1.  F  S ECXCT=$O(^RMPR(660,"CT",ECXCT)),CNT=CNT+1 Q:(ECXCT>ECXED1)!('ECXCT)!(QFLG=1)  D
  1.  .S ECXDACT=0
  1.  .F  S ECXDACT=$O(^RMPR(660,"CT",ECXCT,ECXDACT)) Q:('ECXDACT)!(QFLG=1)  D
  1.  ..;Get data nodes and increment counter
  1.  ..S CNT=CNT+1
  1.  ..S ECX0=$G(^RMPR(660,ECXDACT,0)),ECX1=$G(^(1))
  1.  ..Q:'$D(^RMPR(660,ECXDACT,0))
  1.  ..S ECXPHCPC=$P(ECX1,U,4),ECHCDES=$P(ECX1,U,2),ECXHCPC=$P(ECX0,U,22)
  1.  ..S ECXQTY=$P(ECX0,U,7),ECXUOFI=$P(ECX0,U,8) ;161
  1.  ..;Resolve external values for PSAS HCPC
  1.  ..K DIC S DIC="^RMPR(661.1,",DIC(0)="NZ",X=ECXPHCPC D ^DIC
  1.  ..;S ECXPHCPC=$P($G(Y(0)),U,1)
  1.  ..S ECXPHCPC=$E($P($G(Y(0)),U,1),1,5)
  1.  ..;Resolve external values for HCPC
  1.  ..K DIC S DIC="^ICPT(",DIC(0)="NZ",X=ECXHCPC D ^DIC
  1.  ..S ECXHCPC=$P($G(Y(0)),U,1)
  1.  ..;Resolve external value for unit of issue
  1.  ..K DIC S DIC="^PRCD(420.5,",DIC(0)="NZ",X=ECXUOFI D ^DIC
  1.  ..S ECXUOFI=$P($G(Y(0)),U,2)
  1.  ..S ECXDIV=$$GET1^DIQ(660,ECXDACT,8,"I")
  1.  ..K ECXP D GETS^DIQ(660,ECXDACT_",",".02;11","IE","ECXP") ;154,161
  1.  ..S ECXDFN=$G(ECXP(660,ECXDACT_",",.02,"I")) ;154
  1.  ..S ECXFORM=$G(ECXP(660,ECXDACT_",",11,"E"))_U_$G(ECXP(660,ECXDACT_",",11,"I")) ;154
  1.  ..S (ECXFELOC,ECXFEKEY,ECX15KEY)="" ;161
  1.  ..S ECXLB=$G(^RMPR(660,ECXDACT,"LB")) ;161
  1.  ..S ECXCOST=$S(ECXFORM["-3":+$P(ECXLB,U,9),1:+$P(ECX0,U,16)),ECXTCOST=ECXTCOST+ECXCOST ;161 Use lab total cost if lab related else use total cost
  1.  ..S ECINST=$$GET1^DIQ(4,+$P(ECX0,U,10)_",",99) ;161
  1.  ..S RES=$$NTEG^ECXPRO1(ECXDFN,.ECXLNE,ECXDACT,ECX0,ECXLB,ECINST,$P(ECXFORM,U))  ;161
  1.  ..;Section added in 161 to get feeder key
  1.  ..I ECXFORM["-3" F ECXLAB="ORD","LAB" D
  1.  ...D FEEDINFO^ECXPRO2(ECXSRCE,$E(ECXHCPCS,1,5),ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
  1.  ...S:ECXFELOC'="" ECX15KEY=$S(ECX15KEY'="":ECX15KEY_"/"_ECXFEKEY,1:ECXFEKEY)
  1.  ..I ECXFORM["-3" S ^TMP("ECXDSS",$J,CNT)=ECXPHCPC_U_ECX15KEY_U_ECHCDES_U_$P(ECXFORM,U,2)_$S($G(ECXPORT):(U_$P(ECXFORM,U)),1:"")_U_ECXQTY_U_ECXUOFI_U_ECXCOST ;154,161 Replaced HCPC with FORM data, added feeder 
  1.  ..I ECXFORM'["-3" S ECXLAB="NONL" D
  1.  ...D FEEDINFO^ECXPRO2(ECXSRCE,$E(ECXHCPCS,1,5),ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
  1.  ...S ^TMP("ECXDSS",$J,CNT)=ECXPHCPC_U_ECXFEKEY_U_ECHCDES_U_$P(ECXFORM,U,2)_$S($G(ECXPORT):(U_$P(ECXFORM,U)),1:"")_U_ECXQTY_U_ECXUOFI_U_ECXCOST ;154,161 Replaced HCPC with FORM data, added feeder key
  1.  ..Q
  1.  .Q
  1.  Q
  1.  N LN ;144
  1.  S PAGENUM=PAGENUM+1
  1.  S $P(LN,"-",132)=""
  1.  W @IOF
  1.  W !,"Cost by PSAS HCPC REPORT for "_$P($$SITE^VASITE,U,2)_" station "_$P($$SITE^VASITE,U,3),?120,"Page: ",PAGENUM
  1.  W !!,"Report for ",$$FMTE^XLFDT(ECSD1)," thru ",$$FMTE^XLFDT(ECED)
  1.  W !,?1,"PSAS HCPC",?11,"FEEDER KEY",?30,"DESCRIPTION",?89,"FORM",?98,"QTY",?104,"Unit of Issue",?126,"Cost" ;154 Replaced HCPC with FORM ;161 added feeder key
  1.  W !?1,LN
  1.  Q
  1.  ;
  1. DETAIL ;Print detailed line
  1.  ;Input  :  ^TMP("ECXDSS",$J) full global reference
  1.  ;          ECXPHCPC  -   PSAS HCPCS
  1.  ;          ECXPHDESC -   PSAS HCPC Description
  1.  ;          ECXHCPC   -   HCPCS ;154 No longer on report
  1.  ;          ECXQTY    -   Quantity
  1.  ;          ECXUOFI   -   Unit of issue
  1.  ;          ECXCOST   -   Total cost
  1.  ;          ECXFORM   -   Form requested on
  1.  ;Output  : None
  1.  N RECORD,NODE ;144
  1.  S RECORD=0 F  S RECORD=$O(^TMP("ECXDSS",$J,RECORD)) Q:'RECORD!(STOP)  D
  1.  .S NODE=^TMP("ECXDSS",$J,RECORD)
  1.  .W !?1,$$RJ^XLFSTR($P(NODE,U,1),6),?11,$P($P(NODE,U,2),"/"),?30,$E($P(NODE,U,3),1,57),?89,$P(NODE,U,4),?98,$$LJ^XLFSTR($P(NODE,U,5),5),?107,$P(NODE,U,6) ;154,161
  1.  .W ?122,"$"_$$RJ^XLFSTR($P($P(NODE,U,7),".",1),6)_"."_$$LJ^XLFSTR($P($P(NODE,U,7),".",2),2,0) ;161
  1.  .I $P(NODE,U,2)["/" W !,?11,$P($P(NODE,U,2),"/",2) ;161 print 2nd feeder key if it exists
  1.  .I $Y>(IOSL-5) D WAIT Q:STOP  D HEADER
  1.  .Q
  1.  Q
  1.  ;
  1. TOTAL ;Report totals
  1.  N DASH
  1.  S $P(DASH,"=",15)=""
  1.  W !!,?118,DASH
  1.  W !?90,"Grand Total: ",?118,"$ "_$$RJ^XLFSTR($FNUMBER(ECXTCOST,",",2),11)
  1.  Q
  1.  ;
  1. WAIT ;End of page logic
  1.  ;Input   ; None
  1.  ;Output  ; STOP - Flag inidcating if printing should continue
  1.  ;                 1 = Stop     0 = Continue
  1.  ;
  1.  S STOP=0
  1.  ;CRT - Prompt for continue
  1.  I $E(IOST,1,2)="C-"&(IOSL'>24) D  Q
  1.  .F  Q:$Y>(IOSL-3)  W !
  1.  .N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  .S DIR(0)="E"
  1.  .D ^DIR
  1.  .S STOP=$S(Y'=1:1,1:0)
  1.  ;Background task - check taskman
  1.  S STOP=$$S^%ZTLOAD()
  1.  I STOP D
  1.  .W !,"*********************************************"
  1.  .W !,"*  PRINTING OF REPORT STOPPED AS REQUESTED  *"
  1.  .W !,"*********************************************"
  1.  Q
  1. EXIT ;Kill temp global
  1.  K ^TMP("ECXDSS",$J)
  1.  Q
  1.  ;
  1.  W !,"FORM:"
  1.  W !,"1:PSC",?10,"2:2421",?18,"3:2237",?34,"4:2529-3",?54,"5:2529-7",?74,"6:2472",?83,"7:2431",?99,"8:2914"
  1.  W !,"9:OTHER",?9,"10:2520",?17,"11:STOCK ISSUE",?33,"12:INVENTORY ISSUE",?53,"13:HISTORICAL DATA",?73,"14:VISA",?82,"15:LAB ISSUE-3",?98,"16:DALC"
  1.  Q