- BPCLRML ; IHS/OIT/MJL - GUI GET MY LABS FOR DATE RANGE ;
- ;;1.5;BPC;;MAY 26, 2005
- GETMLDSP(BGUARRAY,BPCPHY,BPCSDATE,BPCEDATE) ;EP REMOTE PROC: BPC GETMYLABS
- ;EP FOR REMOTE PROCEDURE CALL IS GETMLDSP
- TEST S JOB=$J,BPCGUI=1,BPCCTR=1
- K ^XTMP("BPCML",JOB)
- S XWBWRAP=1,BGUARRAY="^XTMP(""BPCML"","_$J_")"
- I 'BPCSDATE S ^XTMP("BPCML",JOB,1)=-1,^XTMP("BPCML",JOB,2)="STARTING DATE NOT DEFINED!" D KILL Q
- I 'BPCEDATE S ^XTMP("BPCML",JOB,1)=-1,^XTMP("BPCML",JOB,2)="ENDING DATE NOT DEFINED!" D KILL Q
- S X1=BPCEDATE,X2=BPCSDATE D ^%DTC I X>31 S ^XTMP("BPCML",JOB,1)=-1,^XTMP("BPCML",JOB,2)="Date range can not exceed one month (31 days)!" D KILL Q
- I '$D(^VA(200,"B",BPCPHY)) S ^XTMP("BPCML",JOB,1)=-1,^XTMP("BPCML",JOB,2)="PROVIDER NAME NOT FOUND!" D KILL Q
- K ^XTMP("BPCML",JOB)
- S BPCSD=BPCSDATE-.0001
- S BPCED=BPCEDATE+.9999
- RUN1 F S BPCSD=$O(^LRO(69,BPCSD)) Q:BPCSD=""!(BPCSD>BPCED) D
- .S BPCPNM="" F S BPCPNM=$O(^LRO(69,BPCSD,1,"AP",BPCPHY,BPCPNM)) Q:BPCPNM="" D
- ..S BPCLRDFN="",BPCLRDFN=$O(^LRO(69,BPCSD,1,"AP",BPCPHY,BPCPNM,BPCLRDFN)) Q:BPCLRDFN=""
- ..S BPCDFN=$P($G(^LR(BPCLRDFN,0)),U,3)
- ..S ^XTMP("BPCML",JOB,"P",BPCPNM)=BPCDFN
- S BPCPNM="",BPCPNM=$O(^XTMP("BPCML",JOB,"P",BPCPNM)) I BPCPNM="" S ^XTMP("BPCML",JOB,1)=2,^XTMP("BPCML",JOB,2)="No Patient Lab Data Found For This User For This Date Range" D KILL Q
- RUN S BPCCTR=1
- S ^XTMP("BPCML",JOB,BPCCTR)="The following Patients have Lab Data Listed Below:",BPCCTR=BPCCTR+1
- S BPCPNM="" F S BPCPNM=$O(^XTMP("BPCML",JOB,"P",BPCPNM)) Q:BPCPNM="" D
- .S DFN=^XTMP("BPCML",JOB,"P",BPCPNM) D PID^VADPT6
- .S ^XTMP("BPCML",JOB,BPCCTR)=BPCPNM_" "
- .S ^XTMP("BPCML",JOB,BPCCTR)=$E(^XTMP("BPCML",JOB,BPCCTR),1,35)_$G(HRCN)_" "
- .S BPCDOB=$P($G(^DPT(DFN,0)),U,3),BPCSEX=$P($G(^(0)),U,2)
- .S:+BPCDOB BPCDOB=$$FMTE^XLFDT(BPCDOB,"5M")
- .S ^XTMP("BPCML",JOB,BPCCTR)=$E(^XTMP("BPCML",JOB,BPCCTR),1,45)_$G(BPCDOB)_" "
- .S ^XTMP("BPCML",JOB,BPCCTR)=$E(^XTMP("BPCML",JOB,BPCCTR),1,58)_$G(BPCSEX)_" "
- .S ^XTMP("BPCML",JOB,BPCCTR)=$E(^XTMP("BPCML",JOB,BPCCTR),1,63)_$G(VA("PID"))
- .S BPCCTR=BPCCTR+1
- S ^XTMP("BPCML",JOB,BPCCTR)="#################################################################################",BPCCTR=BPCCTR+1
- S BPCEDATE=BPCEDATE+1
- S BPCPNM="" F S BPCPNM=$O(^XTMP("BPCML",JOB,"P",BPCPNM)) Q:BPCPNM="" D
- .S BPCDFN=^XTMP("BPCML",JOB,"P",BPCPNM)
- .D INTERIM^BPC7OGM(BGUARRAY,BPCDFN,BPCEDATE,BPCSDATE)
- .S ^XTMP("BPCML",JOB,BPCCTR)="#################################################################################",BPCCTR=BPCCTR+1
- .S ^XTMP("BPCML",JOB,BPCCTR)="Patient: "_BPCPNM,BPCCTR=BPCCTR+1
- .S I=1 F S I=$O(^TMP("BPC7OGX",JOB,"OUTPUT",I)) Q:+I=0 D
- ..S ^XTMP("BPCML",JOB,BPCCTR)=" "_^TMP("BPC7OGX",JOB,"OUTPUT",I),BPCCTR=BPCCTR+1
- .S ^XTMP("BPCML",JOB,BPCCTR)="#################################################################################",BPCCTR=BPCCTR+1
- S ^XTMP("BPCML",JOB,.5)=BPCCTR-1
- D KILL
- Q
- ;
- KILL ;
- K BPCCTR,BPCDFN,BPCED,BPCEDATE,BPCGUI,BPCPNM,BPCSD,I,JOB,X1,X2
- Q
- BPCLRML ; IHS/OIT/MJL - GUI GET MY LABS FOR DATE RANGE ;
- +1 ;;1.5;BPC;;MAY 26, 2005
- GETMLDSP(BGUARRAY,BPCPHY,BPCSDATE,BPCEDATE) ;EP REMOTE PROC: BPC GETMYLABS
- +1 ;EP FOR REMOTE PROCEDURE CALL IS GETMLDSP
- TEST SET JOB=$JOB
- SET BPCGUI=1
- SET BPCCTR=1
- +1 KILL ^XTMP("BPCML",JOB)
- +2 SET XWBWRAP=1
- SET BGUARRAY="^XTMP(""BPCML"","_$JOB_")"
- +3 IF 'BPCSDATE
- SET ^XTMP("BPCML",JOB,1)=-1
- SET ^XTMP("BPCML",JOB,2)="STARTING DATE NOT DEFINED!"
- DO KILL
- QUIT
- +4 IF 'BPCEDATE
- SET ^XTMP("BPCML",JOB,1)=-1
- SET ^XTMP("BPCML",JOB,2)="ENDING DATE NOT DEFINED!"
- DO KILL
- QUIT
- +5 SET X1=BPCEDATE
- SET X2=BPCSDATE
- DO ^%DTC
- IF X>31
- SET ^XTMP("BPCML",JOB,1)=-1
- SET ^XTMP("BPCML",JOB,2)="Date range can not exceed one month (31 days)!"
- DO KILL
- QUIT
- +6 IF '$DATA(^VA(200,"B",BPCPHY))
- SET ^XTMP("BPCML",JOB,1)=-1
- SET ^XTMP("BPCML",JOB,2)="PROVIDER NAME NOT FOUND!"
- DO KILL
- QUIT
- +7 KILL ^XTMP("BPCML",JOB)
- +8 SET BPCSD=BPCSDATE-.0001
- +9 SET BPCED=BPCEDATE+.9999
- RUN1 FOR
- SET BPCSD=$ORDER(^LRO(69,BPCSD))
- IF BPCSD=""!(BPCSD>BPCED)
- QUIT
- Begin DoDot:1
- +1 SET BPCPNM=""
- FOR
- SET BPCPNM=$ORDER(^LRO(69,BPCSD,1,"AP",BPCPHY,BPCPNM))
- IF BPCPNM=""
- QUIT
- Begin DoDot:2
- +2 SET BPCLRDFN=""
- SET BPCLRDFN=$ORDER(^LRO(69,BPCSD,1,"AP",BPCPHY,BPCPNM,BPCLRDFN))
- IF BPCLRDFN=""
- QUIT
- +3 SET BPCDFN=$PIECE($GET(^LR(BPCLRDFN,0)),U,3)
- +4 SET ^XTMP("BPCML",JOB,"P",BPCPNM)=BPCDFN
- End DoDot:2
- End DoDot:1
- +5 SET BPCPNM=""
- SET BPCPNM=$ORDER(^XTMP("BPCML",JOB,"P",BPCPNM))
- IF BPCPNM=""
- SET ^XTMP("BPCML",JOB,1)=2
- SET ^XTMP("BPCML",JOB,2)="No Patient Lab Data Found For This User For This Date Range"
- DO KILL
- QUIT
- RUN SET BPCCTR=1
- +1 SET ^XTMP("BPCML",JOB,BPCCTR)="The following Patients have Lab Data Listed Below:"
- SET BPCCTR=BPCCTR+1
- +2 SET BPCPNM=""
- FOR
- SET BPCPNM=$ORDER(^XTMP("BPCML",JOB,"P",BPCPNM))
- IF BPCPNM=""
- QUIT
- Begin DoDot:1
- +3 SET DFN=^XTMP("BPCML",JOB,"P",BPCPNM)
- DO PID^VADPT6
- +4 SET ^XTMP("BPCML",JOB,BPCCTR)=BPCPNM_" "
- +5 SET ^XTMP("BPCML",JOB,BPCCTR)=$EXTRACT(^XTMP("BPCML",JOB,BPCCTR),1,35)_$GET(HRCN)_" "
- +6 SET BPCDOB=$PIECE($GET(^DPT(DFN,0)),U,3)
- SET BPCSEX=$PIECE($GET(^(0)),U,2)
- +7 IF +BPCDOB
- SET BPCDOB=$$FMTE^XLFDT(BPCDOB,"5M")
- +8 SET ^XTMP("BPCML",JOB,BPCCTR)=$EXTRACT(^XTMP("BPCML",JOB,BPCCTR),1,45)_$GET(BPCDOB)_" "
- +9 SET ^XTMP("BPCML",JOB,BPCCTR)=$EXTRACT(^XTMP("BPCML",JOB,BPCCTR),1,58)_$GET(BPCSEX)_" "
- +10 SET ^XTMP("BPCML",JOB,BPCCTR)=$EXTRACT(^XTMP("BPCML",JOB,BPCCTR),1,63)_$GET(VA("PID"))
- +11 SET BPCCTR=BPCCTR+1
- End DoDot:1
- +12 SET ^XTMP("BPCML",JOB,BPCCTR)="#################################################################################"
- SET BPCCTR=BPCCTR+1
- +13 SET BPCEDATE=BPCEDATE+1
- +14 SET BPCPNM=""
- FOR
- SET BPCPNM=$ORDER(^XTMP("BPCML",JOB,"P",BPCPNM))
- IF BPCPNM=""
- QUIT
- Begin DoDot:1
- +15 SET BPCDFN=^XTMP("BPCML",JOB,"P",BPCPNM)
- +16 DO INTERIM^BPC7OGM(BGUARRAY,BPCDFN,BPCEDATE,BPCSDATE)
- +17 SET ^XTMP("BPCML",JOB,BPCCTR)="#################################################################################"
- SET BPCCTR=BPCCTR+1
- +18 SET ^XTMP("BPCML",JOB,BPCCTR)="Patient: "_BPCPNM
- SET BPCCTR=BPCCTR+1
- +19 SET I=1
- FOR
- SET I=$ORDER(^TMP("BPC7OGX",JOB,"OUTPUT",I))
- IF +I=0
- QUIT
- Begin DoDot:2
- +20 SET ^XTMP("BPCML",JOB,BPCCTR)=" "_^TMP("BPC7OGX",JOB,"OUTPUT",I)
- SET BPCCTR=BPCCTR+1
- End DoDot:2
- +21 SET ^XTMP("BPCML",JOB,BPCCTR)="#################################################################################"
- SET BPCCTR=BPCCTR+1
- End DoDot:1
- +22 SET ^XTMP("BPCML",JOB,.5)=BPCCTR-1
- +23 DO KILL
- +24 QUIT
- +25 ;
- KILL ;
- +1 KILL BPCCTR,BPCDFN,BPCED,BPCEDATE,BPCGUI,BPCPNM,BPCSD,I,JOB,X1,X2
- +2 QUIT
