PXRMGECL ;SLC/AGP,JVS - Restore Func & Utilities ;7/14/05 10:43
;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
Q
;
CNT(DOC,DFN) ;Count number of referals per Provider and patient
N DATE
S CNT=0
S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"DFNCNT",DOC,DFN,DATE)) Q:DATE="" D
.S CNT=CNT+1
Q CNT
POST ;Post Routine to gather old date from health factors
;
D BMES^XPDUTL("Adding data to new file 801.55")
D BMES^XPDUTL("Please Wait.....Thank you")
N TIME,DFN,GEC,DA,GECX,GECNA,HF0,HF12,CNT
S CNT=0
S TIME=0 F S TIME=$O(^AUPNVHF("AED",TIME)) Q:TIME="" D
.Q:TIME'>3000000
.S DFN=0 F S DFN=$O(^AUPNVHF("AED",TIME,DFN)) Q:DFN="" D
..S GEC=0 F S GEC=$O(^AUPNVHF("AED",TIME,DFN,GEC)) Q:GEC="" D
...S GECNA=$P($G(^PX(839.7,GEC,0)),"^",1) Q:GECNA'["GEC"
...S DA=0 F S DA=$O(^AUPNVHF("AED",TIME,DFN,GEC,DA)) Q:DA="" D
....S HF0=$G(^AUPNVHF(DA,0))
....S HF12=$G(^AUPNVHF(DA,12))
....S HF801=$G(^AUPNVHF(DA,801))
....S GECX(1,801.55,"+1,",.01)=DFN
....S GECX(1,801.55,"+1,",.02)=$P(HF12,"^",1)
....S GECX(1,801.55,"+1,",.03)=GECNA
....S GECX(1,801.55,"+1,",.05)=+$P($P(HF801,"^",2)," ",2)
....S GECX(1,801.55,"+1,",.06)=$P($P(HF12,"^",1),".",1)
....I '$D(^PXRMD(801.55,"AE",DFN,$P(HF12,"^",1),GECNA,+$P($P(HF801,"^",2)," ",2))) D
.....D UPDATE^DIE("","GECX(1)")
.....S CNT=CNT+1
.....K GECX,HF0,HF12
S DIK="^PXRMXT(810.3,",DIK(1)="6^AHLID"
D IXALL^DIK
Q
;
REOPEN(NUM) ;Move a referral from the Historial 801.55 to 801.5
Q:NUM=""
N I,GEX
S I=0 F S I=$O(^TMP("PXRMGEC_CK2",$J,NUM,I)) Q:I="" D
.S DA=0 F S DA=$O(^TMP("PXRMGEC_CK2",$J,NUM,I,DA)) Q:DA="" D
..S GEX(1,801.5,"+1,",.01)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",1)
..S GEX(1,801.5,"+1,",.02)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",2)
..S GEX(1,801.5,"+1,",.03)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",3)
..S GEX(1,801.5,"+1,",.04)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",4)
..S GEX(1,801.5,"+1,",.05)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",5)
..S GEX(1,801.5,"+1,",.06)=$P(^TMP("PXRMGEC_CK2",$J,NUM,I,DA),"^",6)
..D UPDATE^DIE("","GEX(1)")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMGECL 2099 printed Sep 23, 2025@19:21:43 Page 2
PXRMGECL ;SLC/AGP,JVS - Restore Func & Utilities ;7/14/05 10:43
+1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
+2 QUIT
+3 ;
CNT(DOC,DFN) ;Count number of referals per Provider and patient
+1 NEW DATE
+2 SET CNT=0
+3 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"DFNCNT",DOC,DFN,DATE))
if DATE=""
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
End DoDot:1
+5 QUIT CNT
POST ;Post Routine to gather old date from health factors
+1 ;
+2 DO BMES^XPDUTL("Adding data to new file 801.55")
+3 DO BMES^XPDUTL("Please Wait.....Thank you")
+4 NEW TIME,DFN,GEC,DA,GECX,GECNA,HF0,HF12,CNT
+5 SET CNT=0
+6 SET TIME=0
FOR
SET TIME=$ORDER(^AUPNVHF("AED",TIME))
if TIME=""
QUIT
Begin DoDot:1
+7 if TIME'>3000000
QUIT
+8 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNVHF("AED",TIME,DFN))
if DFN=""
QUIT
Begin DoDot:2
+9 SET GEC=0
FOR
SET GEC=$ORDER(^AUPNVHF("AED",TIME,DFN,GEC))
if GEC=""
QUIT
Begin DoDot:3
+10 SET GECNA=$PIECE($GET(^PX(839.7,GEC,0)),"^",1)
if GECNA'["GEC"
QUIT
+11 SET DA=0
FOR
SET DA=$ORDER(^AUPNVHF("AED",TIME,DFN,GEC,DA))
if DA=""
QUIT
Begin DoDot:4
+12 SET HF0=$GET(^AUPNVHF(DA,0))
+13 SET HF12=$GET(^AUPNVHF(DA,12))
+14 SET HF801=$GET(^AUPNVHF(DA,801))
+15 SET GECX(1,801.55,"+1,",.01)=DFN
+16 SET GECX(1,801.55,"+1,",.02)=$PIECE(HF12,"^",1)
+17 SET GECX(1,801.55,"+1,",.03)=GECNA
+18 SET GECX(1,801.55,"+1,",.05)=+$PIECE($PIECE(HF801,"^",2)," ",2)
+19 SET GECX(1,801.55,"+1,",.06)=$PIECE($PIECE(HF12,"^",1),".",1)
+20 IF '$DATA(^PXRMD(801.55,"AE",DFN,$PIECE(HF12,"^",1),GECNA,+$PIECE($PIECE(HF801,"^",2)," ",2)))
Begin DoDot:5
+21 DO UPDATE^DIE("","GECX(1)")
+22 SET CNT=CNT+1
+23 KILL GECX,HF0,HF12
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 SET DIK="^PXRMXT(810.3,"
SET DIK(1)="6^AHLID"
+25 DO IXALL^DIK
+26 QUIT
+27 ;
REOPEN(NUM) ;Move a referral from the Historial 801.55 to 801.5
+1 if NUM=""
QUIT
+2 NEW I,GEX
+3 SET I=0
FOR
SET I=$ORDER(^TMP("PXRMGEC_CK2",$JOB,NUM,I))
if I=""
QUIT
Begin DoDot:1
+4 SET DA=0
FOR
SET DA=$ORDER(^TMP("PXRMGEC_CK2",$JOB,NUM,I,DA))
if DA=""
QUIT
Begin DoDot:2
+5 SET GEX(1,801.5,"+1,",.01)=$PIECE(^TMP("PXRMGEC_CK2",$JOB,NUM,I,DA),"^",1)
+6 SET GEX(1,801.5,"+1,",.02)=$PIECE(^TMP("PXRMGEC_CK2",$JOB,NUM,I,DA),"^",2)
+7 SET GEX(1,801.5,"+1,",.03)=$PIECE(^TMP("PXRMGEC_CK2",$JOB,NUM,I,DA),"^",3)
+8 SET GEX(1,801.5,"+1,",.04)=$PIECE(^TMP("PXRMGEC_CK2",$JOB,NUM,I,DA),"^",4)
+9 SET GEX(1,801.5,"+1,",.05)=$PIECE(^TMP("PXRMGEC_CK2",$JOB,NUM,I,DA),"^",5)
+10 SET GEX(1,801.5,"+1,",.06)=$PIECE(^TMP("PXRMGEC_CK2",$JOB,NUM,I,DA),"^",6)
+11 DO UPDATE^DIE("","GEX(1)")
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
