- BPCAPPT ; IHS/OIT/MJL - GUI APPT LIST ;
- ;;1.5;BPC;;MAY 26, 2005
- ;MODIFIED FOR IHS GUI CHART FJE 5/1/00 FROM BPC2D RTN
- ;
- GETAPPT(BGUARRAY,BPCPIEN,BPCSDATE,BPCEDATE) ;EP REMOTE PROC: BPC GET SD APPT DATA
- D ENA,KILL Q
- ;
- ENA ;
- ;S BPCPIEN=25241,BPCSDATE="06/11/00",BPCEDATE="06/11/01"
- D ^XBKVAR
- S BPCCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
- S BPCGUI=1,X="",XWBWRAP=1 K ^TMP($J)
- S BGUARRAY="^TMP("_$J_")"
- I $G(BPCPIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="PATIENT IEN NOT SENT!" Q
- I $G(BPCSDATE)="" S ^TMP($J,1)=-1,^TMP($J,2)="STARTING DATE NOT SENT!" Q
- I $G(BPCEDATE)="" S ^TMP($J,1)=-1,^TMP($J,2)="ENDING DATE NOT SENT!" Q
- S CNTR=2
- S BPCPAT=BPCPIEN
- S:BPCEDATE="" BPCEDATE="T"
- D DT^DILF("",BPCSDATE,.BPCSDAT)
- I BPCSDAT=-1 D
- .S BPCSDATE="1/1/1980"
- .D DT^DILF("",BPCSDATE,.BPCSDAT)
- D DT^DILF("",BPCEDATE,.BPCEDAT)
- I BPCEDAT=-1 D
- .S BPCEDATE="T"
- .D DT^DILF("",BPCEDATE,.BPCEDAT)
- I '$D(^DPT(BPCPAT,"S")) S ^TMP($J,1)=1,^TMP($J,2)="No Appointment Data Available" Q
- D:$O(^DPT(BPCPAT,"S",DT)) PEND
- D:$O(^DPT(BPCPAT,"S",0)) PAST
- I CNTR=2 S ^TMP($J,1)=1,^TMP($J,2)="No Data Available" Q
- S ^TMP($J,1)=CNTR-2
- Q
- ;
- PAST ;
- S BPCN=0 F S BPCN=$O(^DPT(BPCPAT,"S",BPCN)) Q:'BPCN D
- .Q:BPCN<BPCSDAT
- .Q:BPCN>(DT-.01)
- .Q:BPCN>(BPCEDAT+.24)
- .S BPC(9999999-BPCN)=""
- S BPCIDT=0,BPCIDT=$O(BPC(BPCIDT)) I BPCIDT S ^TMP($J,CNTR)="Past:",CNTR=CNTR+1
- S BPCIDT=0 F S BPCIDT=$O(BPC(BPCIDT)) Q:'BPCIDT D
- .S BPCVDT=9999999-BPCIDT
- .S BPCN=^DPT(BPCPAT,"S",BPCVDT,0)
- .S Y=BPCVDT\1 X BPCCVD S BPCDAT=Y
- .S BPCVT=$E($P(BPCVDT,".",2)_"000",1,4) S:BPCVT>1300 BPCVT=BPCVT-1200 S:$L(BPCVT)=3 BPCVT=" "_BPCVT S:$E(BPCVT)="0" BPCVT=" "_$E(BPCVT,2,4) S BPCVT=$E(BPCVT,1,2)_":"_$E(BPCVT,3,4)
- .S BPCTST="" F BPCI=3,4,5 S BPCJ=$P(BPCN,U,BPCI) I BPCJ S:BPCTST]"" BPCTST=BPCTST_"," S BPCTST=BPCTST_$P("^^LAB^XRAY^EKG^",U,BPCI)
- .S BPCCP=+BPCN,BPCCN=$P($G(^SC(BPCCP,0)),U,1)
- .S BPCTST="",BPCVNT=""
- .S BPCVN=0 F BPCQ=0:0 S BPCVN=$O(^SC(BPCCP,"S",BPCVDT,1,BPCVN)) Q:'BPCVN I +^(BPCVN,0)=BPCPAT S BPCTST=$P(^(0),U,2),BPCVNT=$P(^(0),U,4) S:BPCTST BPCTST=BPCTST_" min."
- .F BPCI=3,4,5 S BPCJ=$P(BPCN,U,BPCI) I BPCJ S:BPCTST]"" BPCTST=BPCTST_"," S BPCTST=BPCTST_$P("^^LAB^XRAY^EKG^",U,BPCI)
- .S ^TMP($J,CNTR)=BPCDAT_"^"_BPCVT_"^"_BPCCN S:BPCTST]"" BPCTST="<"_BPCTST_">" S ^TMP($J,CNTR)=^TMP($J,CNTR)_"^"_BPCTST
- .S ^TMP($J,CNTR)=^TMP($J,CNTR)_"^"_BPCVNT
- .S CNTR=CNTR+1
- Q
- ;
- PEND ;
- S CNTR=CNTR+1,^TMP($J,CNTR)="Pending:",CNTR=CNTR+1
- S BPCDAT=0,BPCVDT=DT-.01 F BPCQ=0:0 S BPCVDT=$O(^DPT(BPCPAT,"S",BPCVDT)) Q:'BPCVDT D
- .S BPCN=^DPT(BPCPAT,"S",BPCVDT,0)
- .S Y=BPCVDT\1 X BPCCVD S BPCDAT=Y
- .S BPCVT=$E($P(BPCVDT,".",2)_"000",1,4) S:BPCVT>1300 BPCVT=BPCVT-1200 S:$L(BPCVT)=3 BPCVT=" "_BPCVT S:$E(BPCVT)="0" BPCVT=" "_$E(BPCVT,2,4) S BPCVT=$E(BPCVT,1,2)_":"_$E(BPCVT,3,4)
- .S BPCTST="" F BPCI=3,4,5 S BPCJ=$P(BPCN,U,BPCI) I BPCJ S:BPCTST]"" BPCTST=BPCTST_"," S BPCTST=BPCTST_$P("^^LAB^XRAY^EKG^",U,BPCI)
- .S BPCCP=+BPCN,BPCCN=$P($G(^SC(BPCCP,0)),U,1)
- .S BPCTST="",BPCVNT=""
- .S BPCVN=0 F BPCQ=0:0 S BPCVN=$O(^SC(BPCCP,"S",BPCVDT,1,BPCVN)) Q:'BPCVN I +^(BPCVN,0)=BPCPAT S BPCTST=$P(^(0),U,2),BPCVNT=$P(^(0),U,4) S:BPCTST BPCTST=BPCTST_" min."
- .F BPCI=3,4,5 S BPCJ=$P(BPCN,U,BPCI) I BPCJ S:BPCTST]"" BPCTST=BPCTST_"," S BPCTST=BPCTST_$P("^^LAB^XRAY^EKG^",U,BPCI)
- .S ^TMP($J,CNTR)=BPCDAT_"^"_BPCVT_"^"_BPCCN S:BPCTST]"" BPCTST="<"_BPCTST_">" S ^TMP($J,CNTR)=^TMP($J,CNTR)_"^"_BPCTST
- .S ^TMP($J,CNTR)=^TMP($J,CNTR)_"^"_BPCVNT
- .S CNTR=CNTR+1
- Q
- KILL ;
- K BPC,BPCCN,BPCCP,BPCCVD,BPCDAT,BPCEDATE,BPCGUI,BPCIDT,BPCJ,BPCN,BPCPAT,BPCSDATE,BPCTST,BPCVDT,BPCVN,BPCVNT,BPCVT,CNTR,X,Y
- Q
- BPCAPPT ; IHS/OIT/MJL - GUI APPT LIST ;
- +1 ;;1.5;BPC;;MAY 26, 2005
- +2 ;MODIFIED FOR IHS GUI CHART FJE 5/1/00 FROM BPC2D RTN
- +3 ;
- GETAPPT(BGUARRAY,BPCPIEN,BPCSDATE,BPCEDATE) ;EP REMOTE PROC: BPC GET SD APPT DATA
- +1 DO ENA
- DO KILL
- QUIT
- +2 ;
- ENA ;
- +1 ;S BPCPIEN=25241,BPCSDATE="06/11/00",BPCEDATE="06/11/01"
- +2 DO ^XBKVAR
- +3 SET BPCCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
- +4 SET BPCGUI=1
- SET X=""
- SET XWBWRAP=1
- KILL ^TMP($JOB)
- +5 SET BGUARRAY="^TMP("_$JOB_")"
- +6 IF $GET(BPCPIEN)=""
- SET ^TMP($JOB,1)=-1
- SET ^TMP($JOB,2)="PATIENT IEN NOT SENT!"
- QUIT
- +7 IF $GET(BPCSDATE)=""
- SET ^TMP($JOB,1)=-1
- SET ^TMP($JOB,2)="STARTING DATE NOT SENT!"
- QUIT
- +8 IF $GET(BPCEDATE)=""
- SET ^TMP($JOB,1)=-1
- SET ^TMP($JOB,2)="ENDING DATE NOT SENT!"
- QUIT
- +9 SET CNTR=2
- +10 SET BPCPAT=BPCPIEN
- +11 IF BPCEDATE=""
- SET BPCEDATE="T"
- +12 DO DT^DILF("",BPCSDATE,.BPCSDAT)
- +13 IF BPCSDAT=-1
- Begin DoDot:1
- +14 SET BPCSDATE="1/1/1980"
- +15 DO DT^DILF("",BPCSDATE,.BPCSDAT)
- End DoDot:1
- +16 DO DT^DILF("",BPCEDATE,.BPCEDAT)
- +17 IF BPCEDAT=-1
- Begin DoDot:1
- +18 SET BPCEDATE="T"
- +19 DO DT^DILF("",BPCEDATE,.BPCEDAT)
- End DoDot:1
- +20 IF '$DATA(^DPT(BPCPAT,"S"))
- SET ^TMP($JOB,1)=1
- SET ^TMP($JOB,2)="No Appointment Data Available"
- QUIT
- +21 IF $ORDER(^DPT(BPCPAT,"S",DT))
- DO PEND
- +22 IF $ORDER(^DPT(BPCPAT,"S",0))
- DO PAST
- +23 IF CNTR=2
- SET ^TMP($JOB,1)=1
- SET ^TMP($JOB,2)="No Data Available"
- QUIT
- +24 SET ^TMP($JOB,1)=CNTR-2
- +25 QUIT
- +26 ;
- PAST ;
- +1 SET BPCN=0
- FOR
- SET BPCN=$ORDER(^DPT(BPCPAT,"S",BPCN))
- IF 'BPCN
- QUIT
- Begin DoDot:1
- +2 IF BPCN<BPCSDAT
- QUIT
- +3 IF BPCN>(DT-.01)
- QUIT
- +4 IF BPCN>(BPCEDAT+.24)
- QUIT
- +5 SET BPC(9999999-BPCN)=""
- End DoDot:1
- +6 SET BPCIDT=0
- SET BPCIDT=$ORDER(BPC(BPCIDT))
- IF BPCIDT
- SET ^TMP($JOB,CNTR)="Past:"
- SET CNTR=CNTR+1
- +7 SET BPCIDT=0
- FOR
- SET BPCIDT=$ORDER(BPC(BPCIDT))
- IF 'BPCIDT
- QUIT
- Begin DoDot:1
- +8 SET BPCVDT=9999999-BPCIDT
- +9 SET BPCN=^DPT(BPCPAT,"S",BPCVDT,0)
- +10 SET Y=BPCVDT\1
- XECUTE BPCCVD
- SET BPCDAT=Y
- +11 SET BPCVT=$EXTRACT($PIECE(BPCVDT,".",2)_"000",1,4)
- IF BPCVT>1300
- SET BPCVT=BPCVT-1200
- IF $LENGTH(BPCVT)=3
- SET BPCVT=" "_BPCVT
- IF $EXTRACT(BPCVT)="0"
- SET BPCVT=" "_$EXTRACT(BPCVT,2,4)
- SET BPCVT=$EXTRACT(BPCVT,1,2)_":"_$EXTRACT(BPCVT,3,4)
- +12 SET BPCTST=""
- FOR BPCI=3,4,5
- SET BPCJ=$PIECE(BPCN,U,BPCI)
- IF BPCJ
- IF BPCTST]""
- SET BPCTST=BPCTST_","
- SET BPCTST=BPCTST_$PIECE("^^LAB^XRAY^EKG^",U,BPCI)
- +13 SET BPCCP=+BPCN
- SET BPCCN=$PIECE($GET(^SC(BPCCP,0)),U,1)
- +14 SET BPCTST=""
- SET BPCVNT=""
- +15 SET BPCVN=0
- FOR BPCQ=0:0
- SET BPCVN=$ORDER(^SC(BPCCP,"S",BPCVDT,1,BPCVN))
- IF 'BPCVN
- QUIT
- IF +^(BPCVN,0)=BPCPAT
- SET BPCTST=$PIECE(^(0),U,2)
- SET BPCVNT=$PIECE(^(0),U,4)
- IF BPCTST
- SET BPCTST=BPCTST_" min."
- +16 FOR BPCI=3,4,5
- SET BPCJ=$PIECE(BPCN,U,BPCI)
- IF BPCJ
- IF BPCTST]""
- SET BPCTST=BPCTST_","
- SET BPCTST=BPCTST_$PIECE("^^LAB^XRAY^EKG^",U,BPCI)
- +17 SET ^TMP($JOB,CNTR)=BPCDAT_"^"_BPCVT_"^"_BPCCN
- IF BPCTST]""
- SET BPCTST="<"_BPCTST_">"
- SET ^TMP($JOB,CNTR)=^TMP($JOB,CNTR)_"^"_BPCTST
- +18 SET ^TMP($JOB,CNTR)=^TMP($JOB,CNTR)_"^"_BPCVNT
- +19 SET CNTR=CNTR+1
- End DoDot:1
- +20 QUIT
- +21 ;
- PEND ;
- +1 SET CNTR=CNTR+1
- SET ^TMP($JOB,CNTR)="Pending:"
- SET CNTR=CNTR+1
- +2 SET BPCDAT=0
- SET BPCVDT=DT-.01
- FOR BPCQ=0:0
- SET BPCVDT=$ORDER(^DPT(BPCPAT,"S",BPCVDT))
- IF 'BPCVDT
- QUIT
- Begin DoDot:1
- +3 SET BPCN=^DPT(BPCPAT,"S",BPCVDT,0)
- +4 SET Y=BPCVDT\1
- XECUTE BPCCVD
- SET BPCDAT=Y
- +5 SET BPCVT=$EXTRACT($PIECE(BPCVDT,".",2)_"000",1,4)
- IF BPCVT>1300
- SET BPCVT=BPCVT-1200
- IF $LENGTH(BPCVT)=3
- SET BPCVT=" "_BPCVT
- IF $EXTRACT(BPCVT)="0"
- SET BPCVT=" "_$EXTRACT(BPCVT,2,4)
- SET BPCVT=$EXTRACT(BPCVT,1,2)_":"_$EXTRACT(BPCVT,3,4)
- +6 SET BPCTST=""
- FOR BPCI=3,4,5
- SET BPCJ=$PIECE(BPCN,U,BPCI)
- IF BPCJ
- IF BPCTST]""
- SET BPCTST=BPCTST_","
- SET BPCTST=BPCTST_$PIECE("^^LAB^XRAY^EKG^",U,BPCI)
- +7 SET BPCCP=+BPCN
- SET BPCCN=$PIECE($GET(^SC(BPCCP,0)),U,1)
- +8 SET BPCTST=""
- SET BPCVNT=""
- +9 SET BPCVN=0
- FOR BPCQ=0:0
- SET BPCVN=$ORDER(^SC(BPCCP,"S",BPCVDT,1,BPCVN))
- IF 'BPCVN
- QUIT
- IF +^(BPCVN,0)=BPCPAT
- SET BPCTST=$PIECE(^(0),U,2)
- SET BPCVNT=$PIECE(^(0),U,4)
- IF BPCTST
- SET BPCTST=BPCTST_" min."
- +10 FOR BPCI=3,4,5
- SET BPCJ=$PIECE(BPCN,U,BPCI)
- IF BPCJ
- IF BPCTST]""
- SET BPCTST=BPCTST_","
- SET BPCTST=BPCTST_$PIECE("^^LAB^XRAY^EKG^",U,BPCI)
- +11 SET ^TMP($JOB,CNTR)=BPCDAT_"^"_BPCVT_"^"_BPCCN
- IF BPCTST]""
- SET BPCTST="<"_BPCTST_">"
- SET ^TMP($JOB,CNTR)=^TMP($JOB,CNTR)_"^"_BPCTST
- +12 SET ^TMP($JOB,CNTR)=^TMP($JOB,CNTR)_"^"_BPCVNT
- +13 SET CNTR=CNTR+1
- End DoDot:1
- +14 QUIT
- KILL ;
- +1 KILL BPC,BPCCN,BPCCP,BPCCVD,BPCDAT,BPCEDATE,BPCGUI,BPCIDT,BPCJ,BPCN,BPCPAT,BPCSDATE,BPCTST,BPCVDT,BPCVN,BPCVNT,BPCVT,CNTR,X,Y
- +2 QUIT
