BPCLRML.m

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