PXRMGECW ;SLC/JVS -Extract data for GEC Reports Cont'd ;5/23/03 12:49
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
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
;
PATIENT ;Patient,Count
K ^TMP("PXRMGEC",$J,"REFDFNN")
K ^TMP("PXRMGEC",$J,"REFDFN")
N DATE,DFN,SSN
S DATE="" F S DATE=$O(^TMP("PXRMGEC",$J,"REF",DATE)) Q:DATE="" D
.S DFN="" F S DFN=$O(^TMP("PXRMGEC",$J,"REF",DATE,DFN)) Q:DFN="" D
..S DFNXX=$P($G(^DPT(DFN,0)),"^",1)
..S SSN=$P($G(^DPT(DFN,0)),"^",9)
..I $D(^TMP("PXRMGEC",$J,"REFDFN",DFN)) S ^TMP("PXRMGEC",$J,"REFDFN",DFN)=$G(^TMP("PXRMGEC",$J,"REFDFN",DFN))+1
..E S ^TMP("PXRMGEC",$J,"REFDFN",DFN)=1
..I $D(^TMP("PXRMGEC",$J,"REFDFNN",DFNXX)) S ^TMP("PXRMGEC",$J,"REFDFNN",DFNXX)=$G(^TMP("PXRMGEC",$J,"REFDFNN",DFNXX))+1
..E S ^TMP("PXRMGEC",$J,"REFDFNN",DFNXX)=1
..I $D(^TMP("PXRMGEC",$J,"REFDFNN",DFNXX,SSN)) S ^TMP("PXRMGEC",$J,"REFDFNN",DFNXX,SSN)=$G(^TMP("PXRMGEC",$J,"REFDFNN",DFNXX,SSN))+1
..E S ^TMP("PXRMGEC",$J,"REFDFNN",DFNXX,SSN)=1
;
Q
LOCCNT ;Count by date
N LOC,DATE
S LOC="" F S LOC=$O(^TMP("PXRMGEC",$J,"REFLOC",LOC)) Q:LOC="" D
.S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"REFLOC",LOC,DATE)) Q:DATE="" D
..I $D(^TMP("PXRMGEC",$J,"REFLOCC",LOC)) S ^TMP("PXRMGEC",$J,"REFLOCC",LOC)=$G(^TMP("PXRMGEC",$J,"REFLOCC",LOC))+1
..E S ^TMP("PXRMGEC",$J,"REFLOCC",LOC)=1
Q
;
DOCCNT ;Count by date
N DOC,DATE,DIEN
S DOC="" F S DOC=$O(^TMP("PXRMGEC",$J,"REFDOC",DOC)) Q:DOC="" D
.S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"REFDOC",DOC,DATE)) Q:DATE="" D
..S DIEN=0 F S DIEN=$O(^TMP("PXRMGEC",$J,"REFDOC",DOC,DATE,DIEN)) Q:DIEN="" D
...I $D(^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)) S ^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)=$G(^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN))+1
...E S ^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)=1
Q
;
DATECNT ;Count by date
N DATE,DFN
S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"REF",DATE)) Q:DATE="" D
.S DFN=0 F S DFN=$O(^TMP("PXRMGEC",$J,"REF",DATE,DFN)) Q:DFN="" D
..I $D(^TMP("PXRMGEC",$J,"REFDATE",$P(DATE,".",1))) S ^TMP("PXRMGEC",$J,"REFDATE",$P(DATE,".",1))=$G(^TMP("PXRMGEC",$J,"REFDATE",$P(DATE,".",1)))+1
..E S ^TMP("PXRMGEC",$J,"REFDATE",$P(DATE,".",1))=1
Q
;
INIT ;Initialize values in PCE DATA SOURCE FILE
N GEX,FLAG,III
S FLAG=0
I '$D(^PX(839.7,"B","GEC1")) S GEX(1,839.7,"+1,",.01)="GEC1",FLAG=1
I '$D(^PX(839.7,"B","GEC2")) S GEX(1,839.7,"+2,",.01)="GEC2",FLAG=1
I '$D(^PX(839.7,"B","GEC3")) S GEX(1,839.7,"+3,",.01)="GEC3",FLAG=1
I '$D(^PX(839.7,"B","GECF")) S GEX(1,839.7,"+4,",.01)="GECF",FLAG=1
I FLAG D UPDATE^DIE("","GEX(1)")
;CLEAN OUT 801.5
I $D(^PXRMD(801.5)) D
.S DIK="^PXRMD(801.5,"
.F III=1:1:1000 S DA=III D ^DIK
.K ^PXRMD(801.5,"ACOPY")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMGECW 2898 printed Apr 09, 2024@20:52:56 Page 2
PXRMGECW ;SLC/JVS -Extract data for GEC Reports Cont'd ;5/23/03 12:49
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+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
+10 ;
PATIENT ;Patient,Count
+1 KILL ^TMP("PXRMGEC",$JOB,"REFDFNN")
+2 KILL ^TMP("PXRMGEC",$JOB,"REFDFN")
+3 NEW DATE,DFN,SSN
+4 SET DATE=""
FOR
SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"REF",DATE))
if DATE=""
QUIT
Begin DoDot:1
+5 SET DFN=""
FOR
SET DFN=$ORDER(^TMP("PXRMGEC",$JOB,"REF",DATE,DFN))
if DFN=""
QUIT
Begin DoDot:2
+6 SET DFNXX=$PIECE($GET(^DPT(DFN,0)),"^",1)
+7 SET SSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
+8 IF $DATA(^TMP("PXRMGEC",$JOB,"REFDFN",DFN))
SET ^TMP("PXRMGEC",$JOB,"REFDFN",DFN)=$GET(^TMP("PXRMGEC",$JOB,"REFDFN",DFN))+1
+9 IF '$TEST
SET ^TMP("PXRMGEC",$JOB,"REFDFN",DFN)=1
+10 IF $DATA(^TMP("PXRMGEC",$JOB,"REFDFNN",DFNXX))
SET ^TMP("PXRMGEC",$JOB,"REFDFNN",DFNXX)=$GET(^TMP("PXRMGEC",$JOB,"REFDFNN",DFNXX))+1
+11 IF '$TEST
SET ^TMP("PXRMGEC",$JOB,"REFDFNN",DFNXX)=1
+12 IF $DATA(^TMP("PXRMGEC",$JOB,"REFDFNN",DFNXX,SSN))
SET ^TMP("PXRMGEC",$JOB,"REFDFNN",DFNXX,SSN)=$GET(^TMP("PXRMGEC",$JOB,"REFDFNN",DFNXX,SSN))+1
+13 IF '$TEST
SET ^TMP("PXRMGEC",$JOB,"REFDFNN",DFNXX,SSN)=1
End DoDot:2
End DoDot:1
+14 ;
+15 QUIT
LOCCNT ;Count by date
+1 NEW LOC,DATE
+2 SET LOC=""
FOR
SET LOC=$ORDER(^TMP("PXRMGEC",$JOB,"REFLOC",LOC))
if LOC=""
QUIT
Begin DoDot:1
+3 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"REFLOC",LOC,DATE))
if DATE=""
QUIT
Begin DoDot:2
+4 IF $DATA(^TMP("PXRMGEC",$JOB,"REFLOCC",LOC))
SET ^TMP("PXRMGEC",$JOB,"REFLOCC",LOC)=$GET(^TMP("PXRMGEC",$JOB,"REFLOCC",LOC))+1
+5 IF '$TEST
SET ^TMP("PXRMGEC",$JOB,"REFLOCC",LOC)=1
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
DOCCNT ;Count by date
+1 NEW DOC,DATE,DIEN
+2 SET DOC=""
FOR
SET DOC=$ORDER(^TMP("PXRMGEC",$JOB,"REFDOC",DOC))
if DOC=""
QUIT
Begin DoDot:1
+3 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"REFDOC",DOC,DATE))
if DATE=""
QUIT
Begin DoDot:2
+4 SET DIEN=0
FOR
SET DIEN=$ORDER(^TMP("PXRMGEC",$JOB,"REFDOC",DOC,DATE,DIEN))
if DIEN=""
QUIT
Begin DoDot:3
+5 IF $DATA(^TMP("PXRMGEC",$JOB,"REFDOCC",DOC,DIEN))
SET ^TMP("PXRMGEC",$JOB,"REFDOCC",DOC,DIEN)=$GET(^TMP("PXRMGEC",$JOB,"REFDOCC",DOC,DIEN))+1
+6 IF '$TEST
SET ^TMP("PXRMGEC",$JOB,"REFDOCC",DOC,DIEN)=1
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
DATECNT ;Count by date
+1 NEW DATE,DFN
+2 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"REF",DATE))
if DATE=""
QUIT
Begin DoDot:1
+3 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("PXRMGEC",$JOB,"REF",DATE,DFN))
if DFN=""
QUIT
Begin DoDot:2
+4 IF $DATA(^TMP("PXRMGEC",$JOB,"REFDATE",$PIECE(DATE,".",1)))
SET ^TMP("PXRMGEC",$JOB,"REFDATE",$PIECE(DATE,".",1))=$GET(^TMP("PXRMGEC",$JOB,"REFDATE",$PIECE(DATE,".",1)))+1
+5 IF '$TEST
SET ^TMP("PXRMGEC",$JOB,"REFDATE",$PIECE(DATE,".",1))=1
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
INIT ;Initialize values in PCE DATA SOURCE FILE
+1 NEW GEX,FLAG,III
+2 SET FLAG=0
+3 IF '$DATA(^PX(839.7,"B","GEC1"))
SET GEX(1,839.7,"+1,",.01)="GEC1"
SET FLAG=1
+4 IF '$DATA(^PX(839.7,"B","GEC2"))
SET GEX(1,839.7,"+2,",.01)="GEC2"
SET FLAG=1
+5 IF '$DATA(^PX(839.7,"B","GEC3"))
SET GEX(1,839.7,"+3,",.01)="GEC3"
SET FLAG=1
+6 IF '$DATA(^PX(839.7,"B","GECF"))
SET GEX(1,839.7,"+4,",.01)="GECF"
SET FLAG=1
+7 IF FLAG
DO UPDATE^DIE("","GEX(1)")
+8 ;CLEAN OUT 801.5
+9 IF $DATA(^PXRMD(801.5))
Begin DoDot:1
+10 SET DIK="^PXRMD(801.5,"
+11 FOR III=1:1:1000
SET DA=III
DO ^DIK
+12 KILL ^PXRMD(801.5,"ACOPY")
End DoDot:1
+13 QUIT
