- 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
- 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
