- 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 Feb 18, 2025@23:12:06 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 ;
