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

PXRMG2E1.m

Go to the documentation of this file. 
  1. PXRMG2E1 ;SLC/JVS -GEC #2 Extract initial arrays  ;7/14/05  08:10
  1.  ;;2.0;CLINICAL REMINDERS;**2,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"
  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(^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,TPAT) ;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 TMPDFN,TMPDOC,TMPDT,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=BDT F  S DATE=$O(^AUPNVHF("AED",DATE)) Q:DATE=""  Q:DATE>(EDT+1)  D
  1.  .S DFN="" F  S DFN=$O(^AUPNVHF("AED",DATE,DFN)) Q:DFN=""  D
  1.  ..I $D(TPAT) I TPAT=0 Q:$$TESTPAT^VADPT(DFN)
  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 ARAYS
  1.  Q
  1. KILL ;Kill out unwanted Arrays
  1.  K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
  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,AGE,PXRMAPT,AGEF,SSN
  1.  .;
  1.  .;---AGE---
  1.  .D GETS^DIQ(2,DFN,.033,"ER","AGE")
  1.  .S AGE=AGE(2,DFN_",","AGE","E")
  1.  .S AGEF=0 I AGE>74 S AGEF=1
  1.  .;---SSN---"M3456"
  1.  .D GETS^DIQ(2,DFN,.0905,"ER","SSN")
  1.  .S SSN=SSN(2,DFN_",","1U4N","E")
  1.  .;---APPOINTMENTS---
  1.  .;DBIA #3859
  1.  .S PXRMAPT=0
  1.  .D GETAPPT^SDAMA201(DFN,"1","R",$$FMADD^XLFDT(VDT,-365,0,0,0),VDT,.PXRMAPT,"")
  1.  .I $D(^TMP($J,"SDAMA201","GETAPPT","ERROR")) S PXRMAPT=0
  1.  .K ^TMP($J,"SDAMA201","GETAPPT")
  1.  .;---APPOINTMENTS---
  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.  .S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
  1.  .S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
  1.  .S ^TMP("PXRMGEC",$J,"GEC2",CNTREF,NAMEDA,AGEF,PXRMAPT,DFN,+$E($P(VDT,"."),4,5),SSN,VDT)=""
  1.  .K AGE
  1.  Q
  1.  ;