PXRMGECV ;SLC/JVS -Extract data for GEC Reports ;7/14/05 10:46
;;2.0;CLINICAL REMINDERS;**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",DA=0
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(^PXRMD(801.55,"AC",DFN,DATE,"GECF",0))
..I DA>0 S VDT=$P($G(^PXRMD(801.55,DA,0)),"^",6)
..;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) ;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 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="" F S DATE=$O(^AUPNVHF("AED",DATE)) Q:DATE="" D
.S DFN="" F S DFN=$O(^AUPNVHF("AED",DATE,DFN)) Q:DFN="" D
..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 VDOC(DA)
....D ARAYS
D PATIENT^PXRMGECW
I ARY="CTD" D DATECNT^PXRMGECW
I ARY="CTP" D PATIENT^PXRMGECW
I ARY="CTDR" D DOCCNT^PXRMGECW
I ARY="CTL" D LOCCNT^PXRMGECW
I ARY="LOC" D LOCCNT^PXRMGECW
I ARY="DFN" D DOCCNT^PXRMGECW
Q
KILL ;Kill out unwanted Arrays
K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
Q
VDOC(DA) ;Get Dr's and locationS
Q:ARY="CTD"
Q:ARY="CTP"
;
Q:DA=""
Q:'$D(^AUPNVHF(DA))
S DOCT=+$P($P($G(^AUPNVHF(DA,801)),"^",2)," ",2)
S DOCTN=$$GET1^DIQ(200,DOCT,.01)
Q:DOCTN=""
S ^TMP("PXRMGEC",$J,"REFDOC",DOCTN,VDT,DOCT)=""
;DBIA #10040 However the ability for the Visit to store a pointer
;to the location file might be removed in the future.
S VST=$P($G(^AUPNVHF(DA,0)),"^",3)
Q:'$D(^AUPNVSIT(VST))
S LOC=$P($G(^AUPNVSIT(VST,0)),"^",22)
S LOCN=$P($G(^SC(LOC,0)),"^",1)
S ^TMP("PXRMGEC",$J,"REFLOC",LOCN,VDT)=""
I ARY="DFN" D
.N DSRC,IDENT,DIADA,DIANAME,DATEDA,DATEV
.S DSRC=$P($G(^AUPNVHF(DA,812)),"^",3) ;Pointer to data source file
.S IDENT=$P($G(^PX(839.7,DSRC,0)),"^",1) ;IDENTIFY Name (GEC1)
.Q:'$D(DOCT)
.S DIADA=$O(^PXRMD(801.41,"AC",IDENT,0)) ;Dialog ien
.S ^TMP("PXRMGEC",$J,"DFN",DOCT,DFN,VDT,DIADA)=""
.S ^TMP("PXRMGEC",$J,"DFNCNT",DOCT,DFN,VDT)=""
I ARY="LOC" D
.;#5 Location Report
.S ^TMP("PXRMGEC",$J,"TMPLOC",LOCN,DFNXX,VDT)=""
.S ^TMP("PXRMGEC",$J,"LOCB",LOCN,VDT)=""
;
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
.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)
.Q:DATEV=""
.S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
.S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
.S ^TMP("PXRMGEC",$J,"HS",CNTREF,DFN,DATE,VDT,CAT,DATEV,DA)=""
;===============================================================
I ARY="HS1" 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
.;DFNXX =Patient's Name
.;
.N NAMEDA,NAME,CATDA,CAT,DATEV,DATEDA
.S NAMEDA=$P($G(^AUPNVHF(DA,0)),"^",1)
.S NAME=$P($G(^AUTTHF(NAMEDA,0)),"^",1)
.S DATEDA=$P($G(^AUPNVHF(DA,0)),"^",3)
.S DATEV=$P($G(^AUPNVSIT(DATEDA,0)),"^",1)
.Q:DATEV=""
.S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
.S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
.S ^TMP("PXRMGEC",$J,"HS1",DFNXX,CNTREF,DATE,VDT,CAT,DATEV,DA)=""
.;=============================================================
I ARY="HFCD" D
.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)
.Q:DATEV=""
.S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
.Q:'$D(CATIEN(CATDA))
.S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
.S ^TMP("PXRMGEC",$J,"HFCD",CAT,DFN,NAME,DATEV,DA)=""
Q
PXRMGECV ;SLC/JVS -Extract data for GEC Reports ;7/14/05 10:46
+1 ;;2.0;CLINICAL REMINDERS;**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"
SET DA=0
+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 SET DA=$ORDER(^PXRMD(801.55,"AC",DFN,DATE,"GECF",0))
+6 IF DA>0
SET VDT=$PIECE($GET(^PXRMD(801.55,DA,0)),"^",6)
+7 ;S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,0))
+8 ;S VST=$P($G(^AUPNVHF(DA,0)),"^",3)
+9 ;S VDT=$P($G(^AUPNVSIT(VST,0)),"^",1)
+10 ;S VDT=DATE
End DoDot:2
End DoDot:1
+11 QUIT DONE_"^"_VDT
+12 ;
E(ARY,FIN,BDT,EDT,CHK,DFNONLY) ;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 ;N 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=""
FOR
SET DATE=$ORDER(^AUPNVHF("AED",DATE))
IF DATE=""
QUIT
Begin DoDot:1
+3 SET DFN=""
FOR
SET DFN=$ORDER(^AUPNVHF("AED",DATE,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+4 SET COMPLETE=$$FIN(DATE,DFN)
SET DONE=+COMPLETE
SET VDT=$PIECE(COMPLETE,"^",2)
+5 IF FIN=1&(DONE=0)
QUIT
+6 IF FIN=0&(DONE=1)
QUIT
+7 IF '$$RANG(BDT,EDT,VDT,DATE,CHK)
QUIT
+8 ;
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 VDOC(DA)
+16 DO ARAYS
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 DO PATIENT^PXRMGECW
+18 IF ARY="CTD"
DO DATECNT^PXRMGECW
+19 IF ARY="CTP"
DO PATIENT^PXRMGECW
+20 IF ARY="CTDR"
DO DOCCNT^PXRMGECW
+21 IF ARY="CTL"
DO LOCCNT^PXRMGECW
+22 IF ARY="LOC"
DO LOCCNT^PXRMGECW
+23 IF ARY="DFN"
DO DOCCNT^PXRMGECW
+24 QUIT
KILL ;Kill out unwanted Arrays
+1 KILL ^TMP("PXRMGEC",$JOB,"REF"),^TMP("PXRMGEC",$JOB,"REFDFN")
+2 QUIT
VDOC(DA) ;Get Dr's and locationS
+1 IF ARY="CTD"
QUIT
+2 IF ARY="CTP"
QUIT
+3 ;
+4 IF DA=""
QUIT
+5 IF '$DATA(^AUPNVHF(DA))
QUIT
+6 SET DOCT=+$PIECE($PIECE($GET(^AUPNVHF(DA,801)),"^",2)," ",2)
+7 SET DOCTN=$$GET1^DIQ(200,DOCT,.01)
+8 IF DOCTN=""
QUIT
+9 SET ^TMP("PXRMGEC",$JOB,"REFDOC",DOCTN,VDT,DOCT)=""
+10 ;DBIA #10040 However the ability for the Visit to store a pointer
+11 ;to the location file might be removed in the future.
+12 SET VST=$PIECE($GET(^AUPNVHF(DA,0)),"^",3)
+13 IF '$DATA(^AUPNVSIT(VST))
QUIT
+14 SET LOC=$PIECE($GET(^AUPNVSIT(VST,0)),"^",22)
+15 SET LOCN=$PIECE($GET(^SC(LOC,0)),"^",1)
+16 SET ^TMP("PXRMGEC",$JOB,"REFLOC",LOCN,VDT)=""
+17 IF ARY="DFN"
Begin DoDot:1
+18 NEW DSRC,IDENT,DIADA,DIANAME,DATEDA,DATEV
+19 ;Pointer to data source file
SET DSRC=$PIECE($GET(^AUPNVHF(DA,812)),"^",3)
+20 ;IDENTIFY Name (GEC1)
SET IDENT=$PIECE($GET(^PX(839.7,DSRC,0)),"^",1)
+21 IF '$DATA(DOCT)
QUIT
+22 ;Dialog ien
SET DIADA=$ORDER(^PXRMD(801.41,"AC",IDENT,0))
+23 SET ^TMP("PXRMGEC",$JOB,"DFN",DOCT,DFN,VDT,DIADA)=""
+24 SET ^TMP("PXRMGEC",$JOB,"DFNCNT",DOCT,DFN,VDT)=""
End DoDot:1
+25 IF ARY="LOC"
Begin DoDot:1
+26 ;#5 Location Report
+27 SET ^TMP("PXRMGEC",$JOB,"TMPLOC",LOCN,DFNXX,VDT)=""
+28 SET ^TMP("PXRMGEC",$JOB,"LOCB",LOCN,VDT)=""
End DoDot:1
+29 ;
+30 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
+15 SET NAMEDA=$PIECE($GET(^AUPNVHF(DA,0)),"^",1)
+16 ;GET COMMENTS
+17 SET NAME=$PIECE($GET(^AUTTHF(NAMEDA,0)),"^",1)
+18 SET DATEDA=$PIECE($GET(^AUPNVHF(DA,0)),"^",3)
+19 SET DATEV=$PIECE($GET(^AUPNVSIT(DATEDA,0)),"^",1)
+20 IF DATEV=""
QUIT
+21 SET CATDA=$PIECE($GET(^AUTTHF(NAMEDA,0)),"^",3)
+22 SET CAT=$PIECE($GET(^AUTTHF(CATDA,0)),"^",1)
+23 SET ^TMP("PXRMGEC",$JOB,"HS",CNTREF,DFN,DATE,VDT,CAT,DATEV,DA)=""
End DoDot:1
+24 ;===============================================================
+25 IF ARY="HS1"
Begin DoDot:1
+26 ;CNTREF=Count or numbered Referral
+27 ;DFN =Patient IEN
+28 ;DATE =Starting Date of Referral
+29 ;VDT =Finished Date of Referral-Visit of GECF
+30 ;CAT =Health Factor Category
+31 ;DATEV =Date that each Dialog was done
+32 ;DA =Ien of each Health Factor
+33 ;DFNXX =Patient's Name
+34 ;
+35 NEW NAMEDA,NAME,CATDA,CAT,DATEV,DATEDA
+36 SET NAMEDA=$PIECE($GET(^AUPNVHF(DA,0)),"^",1)
+37 SET NAME=$PIECE($GET(^AUTTHF(NAMEDA,0)),"^",1)
+38 SET DATEDA=$PIECE($GET(^AUPNVHF(DA,0)),"^",3)
+39 SET DATEV=$PIECE($GET(^AUPNVSIT(DATEDA,0)),"^",1)
+40 IF DATEV=""
QUIT
+41 SET CATDA=$PIECE($GET(^AUTTHF(NAMEDA,0)),"^",3)
+42 SET CAT=$PIECE($GET(^AUTTHF(CATDA,0)),"^",1)
+43 SET ^TMP("PXRMGEC",$JOB,"HS1",DFNXX,CNTREF,DATE,VDT,CAT,DATEV,DA)=""
+44 ;=============================================================
End DoDot:1
+45 IF ARY="HFCD"
Begin DoDot:1
+46 SET NAMEDA=$PIECE($GET(^AUPNVHF(DA,0)),"^",1)
+47 ;GET COMMENTS
+48 SET NAME=$PIECE($GET(^AUTTHF(NAMEDA,0)),"^",1)
+49 SET DATEDA=$PIECE($GET(^AUPNVHF(DA,0)),"^",3)
+50 SET DATEV=$PIECE($GET(^AUPNVSIT(DATEDA,0)),"^",1)
+51 IF DATEV=""
QUIT
+52 SET CATDA=$PIECE($GET(^AUTTHF(NAMEDA,0)),"^",3)
+53 IF '$DATA(CATIEN(CATDA))
QUIT
+54 SET CAT=$PIECE($GET(^AUTTHF(CATDA,0)),"^",1)
+55 SET ^TMP("PXRMGEC",$JOB,"HFCD",CAT,DFN,NAME,DATEV,DA)=""
End DoDot:1
+56 QUIT
