PXRMG2E1 ;SLC/JVS -GEC #2 Extract initial arrays ;7/14/05 08:10
;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
Q
;
;Arrays
;^TMP("PXRMGEC",$J, = Root Reference
;"REF",DATE,DFN) = Number of HF in Referral
;"REFDFN",DFN) = Number of Referrals per Patient
;"HS" = Heath Summary Array
Q
GEC ;Get ien for GEC Date Sources
S (GEC1DA,GEC2DA,GEC3DA,GECFDA)=0
S GECFDA=$O(^PX(839.7,"B","GECF",0))
S GEC1DA=$O(^PX(839.7,"B","GEC1",0))
S GEC2DA=$O(^PX(839.7,"B","GEC2",0))
S GEC3DA=$O(^PX(839.7,"B","GEC3",0))
Q
;
RANG(BDT,EDT,VDT,SDT,CHK) ;Dates are in date range
;S=start date F=finished date
N OK,SOK,FOK
S (SOK,FOK,OK)=0
I CHK["S" D
.S:($P(SDT,".",1)'<(BDT))&($P(SDT,".",1)'>(EDT)) SOK=1
I CHK["F" D
.S:($P(VDT,".",1)'<(BDT))&($P(VDT,".",1)'>(EDT)) FOK=1
S OK=$S(SOK=1:1,FOK=1:1,1:0)
I CHK["SF"&(SOK+FOK'=2) S OK=0
Q OK
;
FIN(DATE,DFN) ;Check to see if finished
N GEC,DA,VST,VDT,DONE
S DONE=0,VDT="0000000"
S GEC=0 F S GEC=$O(^AUPNVHF("AED",DATE,DFN,GEC)) Q:GEC="" D
.I GEC=GECFDA S DONE=1 D
..;S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,0))
..;S VST=$P($G(^AUPNVHF(DA,0)),"^",3)
..;S VDT=$P($G(^AUPNVSIT(VST,0)),"^",1)
..S VDT=DATE
Q DONE_"^"_VDT
;
E(ARY,FIN,BDT,EDT,CHK,DFNONLY,TPAT) ;EXTRACT GEC REFERRALS
N DATE,GEC,DFN,DA,DFNX,DATEX,ZALL,CNTREF,COMPLETE
N REFERAL,REFERA,LOCA,LOCN,LOC,DOC,DOCT,DOCTN,DOCTNA
N DOCTOR,DR,DONE,VDT,FLAG,DTCHK,DATE1,DFN1,DATEY,DFNXX
N GEC1DA,GEC2DA,GEC3DA,GECFDA,DFNFLAG
N TMPDFN,TMPDOC,TMPDT,TMPLOC
;====================================================
K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
;====================================================
;Callers Responsibility to Kill the Array
;(ARY,FIN,BDT,EDT,CHK,DFNONLY)
;EXAMPLE FOR HEALTH SUMMARY
;D E^PXRMGECV("HS",2,3020509,3030609,"S",0)
;Parameters
;S ARY="HS"
;Array to Create HS,DT,DFN,DOC,LOC,HFCD
;S FIN=0
;finished referrals 1=finished 0=unfinished 2=Both ""=finished
;S BDT=3020509 Begin Date
;S EDT=3030609 End Date
;S CHK="S"
;Check dates S=Start date Default F=Final date for date range
;S DFNONLY=0
; DFN of patient 0 or all
;=====================================================
;Count of Referrals
S CNTREF=0
D GEC ;get iens for the GECF VARIABLES
;==============
D WORK
Q
WORK ;
S DATE1=0,DFN1=0
S DATE=BDT F S DATE=$O(^AUPNVHF("AED",DATE)) Q:DATE="" Q:DATE>(EDT+1) D
.S DFN="" F S DFN=$O(^AUPNVHF("AED",DATE,DFN)) Q:DFN="" D
..I $D(TPAT) I TPAT=0 Q:$$TESTPAT^VADPT(DFN)
..S COMPLETE=$$FIN(DATE,DFN),DONE=+COMPLETE,VDT=$P(COMPLETE,"^",2)
..Q:FIN=1&(DONE=0)
..Q:FIN=0&(DONE=1)
..Q:'$$RANG(BDT,EDT,VDT,DATE,CHK)
..;
PAT ..;===Check Patient DFN to see if continue or quit
..S DFNFLAG=1 I DFNONLY>0 D Q:DFNFLAG=0
...I $D(DFNARY)&('$D(DFNARY(DFN))) S DFNFLAG=0
...I '$D(DFNARY)&(DFN'=DFNONLY) S DFNFLAG=0
...;======
...;
..S GEC="" F S GEC=$O(^AUPNVHF("AED",DATE,DFN,GEC)) Q:GEC="" D
...Q:GEC'=GECFDA&(GEC'=GEC1DA)&(GEC'=GEC2DA)&(GEC'=GEC3DA)
...S DFNXX=$P($G(^DPT(DFN,0)),"^",1)_" "_$P($G(^DPT(DFN,0)),"^",9)
...S DATEY=$$FMTE^XLFDT(DATE,"1P")
...I $D(^TMP("PXRMGEC",$J,"REF",DATE,DFN)) S ^TMP("PXRMGEC",$J,"REF",DATE,DFN)=$G(^TMP("PXRMGEC",$J,"REF",DATE,DFN))+1
...E S ^TMP("PXRMGEC",$J,"REF",DATE,DFN)=1
...;TO HERE BY REFERRAL
...S DA="" F S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,DA)) Q:DA="" D
....;TO HERE BY HEALTH FACTOR
....D ARAYS
Q
KILL ;Kill out unwanted Arrays
K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
Q
ARAYS ;Set the Arrays for different reports
;===============================================================
;CHeck for new Referral
I DATE1'=DATE!(DFN1'=DFN) S CNTREF=CNTREF+1,DATE1=DATE,DFN1=DFN
;===============================================================
I ARY="HS" D
.;CNTREF=Count or numbered Referral
.;DFN =Patient IEN
.;DATE =Starting Date of Referral
.;VDT =Finished Date of Referral-Visit of GECF
.;CAT =Health Factor Category
.;DATEV =Date that each Dialog was done
.;DA =Ien of each Health Factor
.;
.N NAMEDA,NAME,CATDA,CAT,DATEV,DATEDA,AGE,PXRMAPT,AGEF,SSN
.;
.;---AGE---
.D GETS^DIQ(2,DFN,.033,"ER","AGE")
.S AGE=AGE(2,DFN_",","AGE","E")
.S AGEF=0 I AGE>74 S AGEF=1
.;---SSN---"M3456"
.D GETS^DIQ(2,DFN,.0905,"ER","SSN")
.S SSN=SSN(2,DFN_",","1U4N","E")
.;---APPOINTMENTS---
.;DBIA #3859
.S PXRMAPT=0
.D GETAPPT^SDAMA201(DFN,"1","R",$$FMADD^XLFDT(VDT,-365,0,0,0),VDT,.PXRMAPT,"")
.I $D(^TMP($J,"SDAMA201","GETAPPT","ERROR")) S PXRMAPT=0
.K ^TMP($J,"SDAMA201","GETAPPT")
.;---APPOINTMENTS---
.S NAMEDA=$P($G(^AUPNVHF(DA,0)),"^",1)
.;GET COMMENTS
.S NAME=$P($G(^AUTTHF(NAMEDA,0)),"^",1)
.S DATEDA=$P($G(^AUPNVHF(DA,0)),"^",3)
.S DATEV=$P($G(^AUPNVSIT(DATEDA,0)),"^",1)
.S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
.S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
.S ^TMP("PXRMGEC",$J,"GEC2",CNTREF,NAMEDA,AGEF,PXRMAPT,DFN,+$E($P(VDT,"."),4,5),SSN,VDT)=""
.K AGE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMG2E1 5038 printed Sep 23, 2025@19:21:33 Page 2
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
+2 QUIT
+3 ;
+4 ;Arrays
+5 ;^TMP("PXRMGEC",$J, = Root Reference
+6 ;"REF",DATE,DFN) = Number of HF in Referral
+7 ;"REFDFN",DFN) = Number of Referrals per Patient
+8 ;"HS" = Heath Summary Array
+9 QUIT
GEC ;Get ien for GEC Date Sources
+1 SET (GEC1DA,GEC2DA,GEC3DA,GECFDA)=0
+2 SET GECFDA=$ORDER(^PX(839.7,"B","GECF",0))
+3 SET GEC1DA=$ORDER(^PX(839.7,"B","GEC1",0))
+4 SET GEC2DA=$ORDER(^PX(839.7,"B","GEC2",0))
+5 SET GEC3DA=$ORDER(^PX(839.7,"B","GEC3",0))
+6 QUIT
+7 ;
RANG(BDT,EDT,VDT,SDT,CHK) ;Dates are in date range
+1 ;S=start date F=finished date
+2 NEW OK,SOK,FOK
+3 SET (SOK,FOK,OK)=0
+4 IF CHK["S"
Begin DoDot:1
+5 if ($PIECE(SDT,".",1)'<(BDT))&($PIECE(SDT,".",1)'>(EDT))
SET SOK=1
End DoDot:1
+6 IF CHK["F"
Begin DoDot:1
+7 if ($PIECE(VDT,".",1)'<(BDT))&($PIECE(VDT,".",1)'>(EDT))
SET FOK=1
End DoDot:1
+8 SET OK=$SELECT(SOK=1:1,FOK=1:1,1:0)
+9 IF CHK["SF"&(SOK+FOK'=2)
SET OK=0
+10 QUIT OK
+11 ;
FIN(DATE,DFN) ;Check to see if finished
+1 NEW GEC,DA,VST,VDT,DONE
+2 SET DONE=0
SET VDT="0000000"
+3 SET GEC=0
FOR
SET GEC=$ORDER(^AUPNVHF("AED",DATE,DFN,GEC))
if GEC=""
QUIT
Begin DoDot:1
+4 IF GEC=GECFDA
SET DONE=1
Begin DoDot:2
+5 ;S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,0))
+6 ;S VST=$P($G(^AUPNVHF(DA,0)),"^",3)
+7 ;S VDT=$P($G(^AUPNVSIT(VST,0)),"^",1)
+8 SET VDT=DATE
End DoDot:2
End DoDot:1
+9 QUIT DONE_"^"_VDT
+10 ;
E(ARY,FIN,BDT,EDT,CHK,DFNONLY,TPAT) ;EXTRACT GEC REFERRALS
+1 NEW DATE,GEC,DFN,DA,DFNX,DATEX,ZALL,CNTREF,COMPLETE
+2 NEW REFERAL,REFERA,LOCA,LOCN,LOC,DOC,DOCT,DOCTN,DOCTNA
+3 NEW DOCTOR,DR,DONE,VDT,FLAG,DTCHK,DATE1,DFN1,DATEY,DFNXX
+4 NEW GEC1DA,GEC2DA,GEC3DA,GECFDA,DFNFLAG
+5 NEW TMPDFN,TMPDOC,TMPDT,TMPLOC
+6 ;====================================================
+7 KILL ^TMP("PXRMGEC",$JOB,"REF"),^TMP("PXRMGEC",$JOB,"REFDFN")
+8 ;====================================================
+9 ;Callers Responsibility to Kill the Array
+10 ;(ARY,FIN,BDT,EDT,CHK,DFNONLY)
+11 ;EXAMPLE FOR HEALTH SUMMARY
+12 ;D E^PXRMGECV("HS",2,3020509,3030609,"S",0)
+13 ;Parameters
+14 ;S ARY="HS"
+15 ;Array to Create HS,DT,DFN,DOC,LOC,HFCD
+16 ;S FIN=0
+17 ;finished referrals 1=finished 0=unfinished 2=Both ""=finished
+18 ;S BDT=3020509 Begin Date
+19 ;S EDT=3030609 End Date
+20 ;S CHK="S"
+21 ;Check dates S=Start date Default F=Final date for date range
+22 ;S DFNONLY=0
+23 ; DFN of patient 0 or all
+24 ;=====================================================
+25 ;Count of Referrals
+26 SET CNTREF=0
+27 ;get iens for the GECF VARIABLES
DO GEC
+28 ;==============
+29 DO WORK
+30 QUIT
WORK ;
+1 SET DATE1=0
SET DFN1=0
+2 SET DATE=BDT
FOR
SET DATE=$ORDER(^AUPNVHF("AED",DATE))
if DATE=""
QUIT
if DATE>(EDT+1)
QUIT
Begin DoDot:1
+3 SET DFN=""
FOR
SET DFN=$ORDER(^AUPNVHF("AED",DATE,DFN))
if DFN=""
QUIT
Begin DoDot:2
+4 IF $DATA(TPAT)
IF TPAT=0
if $$TESTPAT^VADPT(DFN)
QUIT
+5 SET COMPLETE=$$FIN(DATE,DFN)
SET DONE=+COMPLETE
SET VDT=$PIECE(COMPLETE,"^",2)
+6 if FIN=1&(DONE=0)
QUIT
+7 if FIN=0&(DONE=1)
QUIT
+8 if '$$RANG(BDT,EDT,VDT,DATE,CHK)
QUIT
+9 ;
PAT ;===Check Patient DFN to see if continue or quit
+1 SET DFNFLAG=1
IF DFNONLY>0
Begin DoDot:3
+2 IF $DATA(DFNARY)&('$DATA(DFNARY(DFN)))
SET DFNFLAG=0
+3 IF '$DATA(DFNARY)&(DFN'=DFNONLY)
SET DFNFLAG=0
+4 ;======
+5 ;
End DoDot:3
if DFNFLAG=0
QUIT
+6 SET GEC=""
FOR
SET GEC=$ORDER(^AUPNVHF("AED",DATE,DFN,GEC))
if GEC=""
QUIT
Begin DoDot:3
+7 if GEC'=GECFDA&(GEC'=GEC1DA)&(GEC'=GEC2DA)&(GEC'=GEC3DA)
QUIT
+8 SET DFNXX=$PIECE($GET(^DPT(DFN,0)),"^",1)_" "_$PIECE($GET(^DPT(DFN,0)),"^",9)
+9 SET DATEY=$$FMTE^XLFDT(DATE,"1P")
+10 IF $DATA(^TMP("PXRMGEC",$JOB,"REF",DATE,DFN))
SET ^TMP("PXRMGEC",$JOB,"REF",DATE,DFN)=$GET(^TMP("PXRMGEC",$JOB,"REF",DATE,DFN))+1
+11 IF '$TEST
SET ^TMP("PXRMGEC",$JOB,"REF",DATE,DFN)=1
+12 ;TO HERE BY REFERRAL
+13 SET DA=""
FOR
SET DA=$ORDER(^AUPNVHF("AED",DATE,DFN,GEC,DA))
if DA=""
QUIT
Begin DoDot:4
+14 ;TO HERE BY HEALTH FACTOR
+15 DO ARAYS
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
KILL ;Kill out unwanted Arrays
+1 KILL ^TMP("PXRMGEC",$JOB,"REF"),^TMP("PXRMGEC",$JOB,"REFDFN")
+2 QUIT
ARAYS ;Set the Arrays for different reports
+1 ;===============================================================
+2 ;CHeck for new Referral
+3 IF DATE1'=DATE!(DFN1'=DFN)
SET CNTREF=CNTREF+1
SET DATE1=DATE
SET DFN1=DFN
+4 ;===============================================================
+5 IF ARY="HS"
Begin DoDot:1
+6 ;CNTREF=Count or numbered Referral
+7 ;DFN =Patient IEN
+8 ;DATE =Starting Date of Referral
+9 ;VDT =Finished Date of Referral-Visit of GECF
+10 ;CAT =Health Factor Category
+11 ;DATEV =Date that each Dialog was done
+12 ;DA =Ien of each Health Factor
+13 ;
+14 NEW NAMEDA,NAME,CATDA,CAT,DATEV,DATEDA,AGE,PXRMAPT,AGEF,SSN
+15 ;
+16 ;---AGE---
+17 DO GETS^DIQ(2,DFN,.033,"ER","AGE")
+18 SET AGE=AGE(2,DFN_",","AGE","E")
+19 SET AGEF=0
IF AGE>74
SET AGEF=1
+20 ;---SSN---"M3456"
+21 DO GETS^DIQ(2,DFN,.0905,"ER","SSN")
+22 SET SSN=SSN(2,DFN_",","1U4N","E")
+23 ;---APPOINTMENTS---
+24 ;DBIA #3859
+25 SET PXRMAPT=0
+26 DO GETAPPT^SDAMA201(DFN,"1","R",$$FMADD^XLFDT(VDT,-365,0,0,0),VDT,.PXRMAPT,"")
+27 IF $DATA(^TMP($JOB,"SDAMA201","GETAPPT","ERROR"))
SET PXRMAPT=0
+28 KILL ^TMP($JOB,"SDAMA201","GETAPPT")
+29 ;---APPOINTMENTS---
+30 SET NAMEDA=$PIECE($GET(^AUPNVHF(DA,0)),"^",1)
+31 ;GET COMMENTS
+32 SET NAME=$PIECE($GET(^AUTTHF(NAMEDA,0)),"^",1)
+33 SET DATEDA=$PIECE($GET(^AUPNVHF(DA,0)),"^",3)
+34 SET DATEV=$PIECE($GET(^AUPNVSIT(DATEDA,0)),"^",1)
+35 SET CATDA=$PIECE($GET(^AUTTHF(NAMEDA,0)),"^",3)
+36 SET CAT=$PIECE($GET(^AUTTHF(CATDA,0)),"^",1)
+37 SET ^TMP("PXRMGEC",$JOB,"GEC2",CNTREF,NAMEDA,AGEF,PXRMAPT,DFN,+$EXTRACT($PIECE(VDT,"."),4,5),SSN,VDT)=""
+38 KILL AGE
End DoDot:1
+39 QUIT
+40 ;
