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

PXRMGECV.m

Go to the documentation of this file. 
  1. PXRMGECV ;SLC/JVS -Extract data for GEC Reports ;7/14/05  10:46
  1.  ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
  1.  Q
  1.  ;
  1.  ;Arrays
  1.  ;^TMP("PXRMGEC",$J,    = Root Reference
  1.  ;"REF",DATE,DFN)       = Number of HF in Referral
  1.  ;"REFDFN",DFN)         = Number of Referrals per Patient
  1.  ;"HS"                  = Heath Summary Array
  1.  Q
  1. GEC ;Get ien for GEC Date Sources
  1.  S (GEC1DA,GEC2DA,GEC3DA,GECFDA)=0
  1.  S GECFDA=$O(^PX(839.7,"B","GECF",0))
  1.  S GEC1DA=$O(^PX(839.7,"B","GEC1",0))
  1.  S GEC2DA=$O(^PX(839.7,"B","GEC2",0))
  1.  S GEC3DA=$O(^PX(839.7,"B","GEC3",0))
  1.  Q
  1.  ;
  1. RANG(BDT,EDT,VDT,SDT,CHK) ;Dates are in date range
  1.  ;S=start date F=finished date
  1.  N OK,SOK,FOK
  1.  S (SOK,FOK,OK)=0
  1.  I CHK["S" D
  1.  .S:($P(SDT,".",1)'<(BDT))&($P(SDT,".",1)'>(EDT)) SOK=1
  1.  I CHK["F" D
  1.  .S:($P(VDT,".",1)'<(BDT))&($P(VDT,".",1)'>(EDT)) FOK=1
  1.  S OK=$S(SOK=1:1,FOK=1:1,1:0)
  1.  I CHK["SF"&(SOK+FOK'=2) S OK=0
  1.  Q OK
  1.  ;
  1. FIN(DATE,DFN) ;Check to see if finished
  1.  N GEC,DA,VST,VDT,DONE
  1.  S DONE=0,VDT="0000000",DA=0
  1.  S GEC=0 F  S GEC=$O(^AUPNVHF("AED",DATE,DFN,GEC)) Q:GEC=""  D
  1.  .I GEC=GECFDA S DONE=1 D
  1.  ..S DA=$O(^PXRMD(801.55,"AC",DFN,DATE,"GECF",0))
  1.  ..I DA>0 S VDT=$P($G(^PXRMD(801.55,DA,0)),"^",6)
  1.  ..;S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,0))
  1.  ..;S VST=$P($G(^AUPNVHF(DA,0)),"^",3)
  1.  ..;S VDT=$P($G(^AUPNVSIT(VST,0)),"^",1)
  1.  ..;S VDT=DATE
  1.  Q DONE_"^"_VDT
  1.  ;
  1. E(ARY,FIN,BDT,EDT,CHK,DFNONLY) ;EXTRACT GEC REFERRALS
  1.  N DATE,GEC,DFN,DA,DFNX,DATEX,ZALL,CNTREF,COMPLETE
  1.  N REFERAL,REFERA,LOCA,LOCN,LOC,DOC,DOCT,DOCTN,DOCTNA
  1.  N DOCTOR,DR,DONE,VDT,FLAG,DTCHK,DATE1,DFN1,DATEY,DFNXX
  1.  N GEC1DA,GEC2DA,GEC3DA,GECFDA,DFNFLAG
  1.  ;N TMPLOC
  1.  ;====================================================
  1.  K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
  1.  ;====================================================
  1.  ;Callers Responsibility to Kill the Array
  1.  ;(ARY,FIN,BDT,EDT,CHK,DFNONLY)
  1.  ;EXAMPLE FOR HEALTH SUMMARY
  1.  ;D E^PXRMGECV("HS",2,3020509,3030609,"S",0)
  1.  ;Parameters
  1.  ;S ARY="HS"
  1.  ;Array to Create HS,DT,DFN,DOC,LOC,HFCD
  1.  ;S FIN=0
  1.  ;finished referrals 1=finished 0=unfinished 2=Both ""=finished
  1.  ;S BDT=3020509 Begin Date
  1.  ;S EDT=3030609 End Date
  1.  ;S CHK="S"
  1.  ;Check dates S=Start date Default F=Final date for date range
  1.  ;S DFNONLY=0
  1.  ; DFN of patient 0 or all
  1.  ;=====================================================
  1.  ;Count of Referrals
  1.  S CNTREF=0
  1.  D GEC ;get iens for the GECF VARIABLES
  1.  ;==============
  1.  D WORK
  1.  Q
  1. WORK ;
  1.  S DATE1=0,DFN1=0
  1.  S DATE="" F  S DATE=$O(^AUPNVHF("AED",DATE)) Q:DATE=""  D
  1.  .S DFN="" F  S DFN=$O(^AUPNVHF("AED",DATE,DFN)) Q:DFN=""  D
  1.  ..S COMPLETE=$$FIN(DATE,DFN),DONE=+COMPLETE,VDT=$P(COMPLETE,"^",2)
  1.  ..Q:FIN=1&(DONE=0)
  1.  ..Q:FIN=0&(DONE=1)
  1.  ..Q:'$$RANG(BDT,EDT,VDT,DATE,CHK)
  1.  ..;
  1. PAT ..;===Check Patient DFN to see if continue or quit
  1.  ..S DFNFLAG=1 I DFNONLY>0 D  Q:DFNFLAG=0
  1.  ...I $D(DFNARY)&('$D(DFNARY(DFN))) S DFNFLAG=0
  1.  ...I '$D(DFNARY)&(DFN'=DFNONLY) S DFNFLAG=0
  1.  ...;======
  1.  ...;
  1.  ..S GEC="" F  S GEC=$O(^AUPNVHF("AED",DATE,DFN,GEC)) Q:GEC=""  D
  1.  ...Q:GEC'=GECFDA&(GEC'=GEC1DA)&(GEC'=GEC2DA)&(GEC'=GEC3DA)
  1.  ...S DFNXX=$P($G(^DPT(DFN,0)),"^",1)_" "_$P($G(^DPT(DFN,0)),"^",9)
  1.  ...S DATEY=$$FMTE^XLFDT(DATE,"1P")
  1.  ...I $D(^TMP("PXRMGEC",$J,"REF",DATE,DFN)) S ^TMP("PXRMGEC",$J,"REF",DATE,DFN)=$G(^TMP("PXRMGEC",$J,"REF",DATE,DFN))+1
  1.  ...E  S ^TMP("PXRMGEC",$J,"REF",DATE,DFN)=1
  1.  ...;TO HERE BY REFERRAL
  1.  ...S DA="" F  S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,DA)) Q:DA=""  D
  1.  ....;TO HERE BY HEALTH FACTOR
  1.  ....D VDOC(DA)
  1.  ....D ARAYS
  1.  D PATIENT^PXRMGECW
  1.  I ARY="CTD" D DATECNT^PXRMGECW
  1.  I ARY="CTP" D PATIENT^PXRMGECW
  1.  I ARY="CTDR" D DOCCNT^PXRMGECW
  1.  I ARY="CTL" D LOCCNT^PXRMGECW
  1.  I ARY="LOC" D LOCCNT^PXRMGECW
  1.  I ARY="DFN" D DOCCNT^PXRMGECW
  1.  Q
  1. KILL ;Kill out unwanted Arrays
  1.  K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
  1.  Q
  1. VDOC(DA) ;Get Dr's and locationS
  1.  Q:ARY="CTD"
  1.  Q:ARY="CTP"
  1.  ;
  1.  Q:DA=""
  1.  Q:'$D(^AUPNVHF(DA))
  1.  S DOCT=+$P($P($G(^AUPNVHF(DA,801)),"^",2)," ",2)
  1.  S DOCTN=$$GET1^DIQ(200,DOCT,.01)
  1.  Q:DOCTN=""
  1.  S ^TMP("PXRMGEC",$J,"REFDOC",DOCTN,VDT,DOCT)=""
  1.  ;DBIA #10040 However the ability for the Visit to store a pointer
  1.  ;to the location file might be removed in the future.
  1.  S VST=$P($G(^AUPNVHF(DA,0)),"^",3)
  1.  Q:'$D(^AUPNVSIT(VST))
  1.  S LOC=$P($G(^AUPNVSIT(VST,0)),"^",22)
  1.  S LOCN=$P($G(^SC(LOC,0)),"^",1)
  1.  S ^TMP("PXRMGEC",$J,"REFLOC",LOCN,VDT)=""
  1.  I ARY="DFN" D
  1.  .N DSRC,IDENT,DIADA,DIANAME,DATEDA,DATEV
  1.  .S DSRC=$P($G(^AUPNVHF(DA,812)),"^",3) ;Pointer to data source file
  1.  .S IDENT=$P($G(^PX(839.7,DSRC,0)),"^",1) ;IDENTIFY Name (GEC1)
  1.  .Q:'$D(DOCT)
  1.  .S DIADA=$O(^PXRMD(801.41,"AC",IDENT,0)) ;Dialog ien
  1.  .S ^TMP("PXRMGEC",$J,"DFN",DOCT,DFN,VDT,DIADA)=""
  1.  .S ^TMP("PXRMGEC",$J,"DFNCNT",DOCT,DFN,VDT)=""
  1.  I ARY="LOC" D
  1.  .;#5 Location Report
  1.  .S ^TMP("PXRMGEC",$J,"TMPLOC",LOCN,DFNXX,VDT)=""
  1.  .S ^TMP("PXRMGEC",$J,"LOCB",LOCN,VDT)=""
  1.  ;
  1.  Q
  1. ARAYS ;Set the Arrays for different reports
  1.  ;===============================================================
  1.  ;CHeck for new Referral
  1.  I DATE1'=DATE!(DFN1'=DFN) S CNTREF=CNTREF+1,DATE1=DATE,DFN1=DFN
  1.  ;===============================================================
  1.  I ARY="HS" D
  1.  .;CNTREF=Count or numbered Referral
  1.  .;DFN   =Patient IEN
  1.  .;DATE  =Starting Date of Referral
  1.  .;VDT   =Finished Date of Referral-Visit of GECF
  1.  .;CAT   =Health Factor Category
  1.  .;DATEV =Date that each Dialog was done
  1.  .;DA    =Ien of each Health Factor
  1.  .;
  1.  .N NAMEDA,NAME,CATDA,CAT,DATEV,DATEDA
  1.  .S NAMEDA=$P($G(^AUPNVHF(DA,0)),"^",1)
  1.  .;GET COMMENTS
  1.  .S NAME=$P($G(^AUTTHF(NAMEDA,0)),"^",1)
  1.  .S DATEDA=$P($G(^AUPNVHF(DA,0)),"^",3)
  1.  .S DATEV=$P($G(^AUPNVSIT(DATEDA,0)),"^",1)
  1.  .Q:DATEV=""
  1.  .S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
  1.  .S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
  1.  .S ^TMP("PXRMGEC",$J,"HS",CNTREF,DFN,DATE,VDT,CAT,DATEV,DA)=""
  1.  ;===============================================================
  1.  I ARY="HS1" D
  1.  .;CNTREF=Count or numbered Referral
  1.  .;DFN   =Patient IEN
  1.  .;DATE  =Starting Date of Referral
  1.  .;VDT   =Finished Date of Referral-Visit of GECF
  1.  .;CAT   =Health Factor Category
  1.  .;DATEV =Date that each Dialog was done
  1.  .;DA    =Ien of each Health Factor
  1.  .;DFNXX =Patient's Name
  1.  .;
  1.  .N NAMEDA,NAME,CATDA,CAT,DATEV,DATEDA
  1.  .S NAMEDA=$P($G(^AUPNVHF(DA,0)),"^",1)
  1.  .S NAME=$P($G(^AUTTHF(NAMEDA,0)),"^",1)
  1.  .S DATEDA=$P($G(^AUPNVHF(DA,0)),"^",3)
  1.  .S DATEV=$P($G(^AUPNVSIT(DATEDA,0)),"^",1)
  1.  .Q:DATEV=""
  1.  .S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
  1.  .S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
  1.  .S ^TMP("PXRMGEC",$J,"HS1",DFNXX,CNTREF,DATE,VDT,CAT,DATEV,DA)=""
  1.  .;=============================================================
  1.  I ARY="HFCD" D
  1.  .S NAMEDA=$P($G(^AUPNVHF(DA,0)),"^",1)
  1.  .;GET COMMENTS
  1.  .S NAME=$P($G(^AUTTHF(NAMEDA,0)),"^",1)
  1.  .S DATEDA=$P($G(^AUPNVHF(DA,0)),"^",3)
  1.  .S DATEV=$P($G(^AUPNVSIT(DATEDA,0)),"^",1)
  1.  .Q:DATEV=""
  1.  .S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
  1.  .Q:'$D(CATIEN(CATDA))
  1.  .S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
  1.  .S ^TMP("PXRMGEC",$J,"HFCD",CAT,DFN,NAME,DATEV,DA)=""
  1.  Q