APSPORXF ;IHS/DSD/ENM - FUNCTION CALLS FROM PCC ;09-Oct-2008 11:26;SM
;;7.0;IHS PHARMACY MODIFICATIONS;**1007**;Sep 23, 2004
;
;Modified - IHS/MSC/PLS - 05/19/08 - Line MEDS+13
;function calls from pcc
MEDS(DFN,APSPA,APSPBD,APSPED,APSPSC,APSPVT) ;EP - GET MEDS IN DATE RANGE FOR A PATIENT, SCREEN OPTIONALLY ON SERV CAT OR TYPE
NEW APSPX,APSPDFE,APSPDAT,APSPV,APSPVR,APSPI,APSPC,APSPR,APSPER
S APSPER=0
I 'DFN S APSPER=1 Q APSPER ;no patient
I '$D(^DPT(DFN)) S APSPER=1 Q APSPER ;patient not valid
I $G(APSPA)="" S APSPER=2 Q APSPER ;no array defined
I $G(APSPSC)="" S APSPSC=""
I $G(APSPVT)="" S APSPVT=""
;set up data fetcher call
S APSPX=DFN_"^ALL MEDS" D
.I APSPED="" S APSPED=DT
.I APSPBD]""!(APSPED]"") S APSPX=APSPX_";DURING "_APSPBD_"-"_APSPED
.Q
;IHS/MSC/PLS - 05/19/08 - Updated call to PCC
;S APSPDFE=$$^APCLDF(APSPX,"APSPDAT(")
S APSPDFE=$$START1^APCLDF(APSPX,"APSPDAT(")
I APSPDFE S APSPER=3 Q APSPER ;date fetcher error
I '$D(APSPDAT) Q APSPER
S (APSPX,APSPC)=0 F S APSPX=$O(APSPDAT(APSPX)) Q:APSPX'=+APSPX D
.S APSPV=$P(APSPDAT(APSPX),U,5),APSPVR=^AUPNVSIT(APSPV,0)
.I APSPSC]"",APSPSC'[$P(APSPVR,U,7) Q
.I APSPVT]"",APSPVT'[$P(APSPVR,U,3) Q
.S APSPI=+$P(APSPDAT(APSPX),U,4),APSPR=^AUPNVMED(APSPI,0)
.S A=APSPA_APSPX_")" S @A=APSPI_U_APSPV_U_$P(APSPDAT(APSPX),U)_U_$P(APSPR,U)_U_$P(APSPDAT(APSPX),U,2)
.F X=4:1:8 S @A=@A_U_$P(APSPR,U,X)
.S @A=@A_U_$P($G(^AUPNVSIT(APSPV,21)),U)
.I $G(^AUPNVMED(APSPI,12)) F X=1:1:4 S @A=@A_U_$P(^AUPNVMED(APSPI,12),U,X)
.Q
Q APSPER
;
START ;EP called from option to display all outside Rx/s
W:$D(IOF) @IOF
W !!?18,"DISPLAY OUTSIDE RX's",!!
GETPAT ;
D GETPAT^APSPORXA ; get patient
I 'DFN D EXIT Q
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date for Rx display" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G GETPAT
S APSPBD=Y
ED ;get ending date
W ! S DIR(0)="D^"_APSPBD_":DT:EP",DIR("A")="Enter ending Date for Rx display" S Y=APSPBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APSPED=Y
;
GETMEDS ; get vmeds to display
K APSPQUIT
S APSPERR=$$MEDS(DFN,"APSPORX(",APSPBD,APSPED,"E")
I APSPERR W !!,$C(7),$C(7),"Error occurred when attempting to find outside Rx's!! Notify supervisor" D PAUSE G EXIT
I '$D(APSPORX) W !!,$C(7),"No Outside Rx's on file for ",$P(^DPT(DFN,0),U),!,"in that time period",! D PAUSE G GETPAT
S APSPPG=0 D HEAD
S APSPY=0 F S APSPY=$O(APSPORX(APSPY)) Q:APSPY'=+APSPY!($D(APSPQUIT)) S X=APSPORX(APSPY) D
.I $Y>(IOSL-4) D HEAD Q:$D(APSPQUIT)
.;W !!,APSPY,")",?5,"Drug Name: ",?23,$S($P(X,U,5)]"":$P(X,U,5),1:$P(X,U,4))
.W !!,APSPY,")",?5,"Drug Name: ",?23,$S($P(X,U,6)]"":$P(X,U,6),1:$P(X,U,5)) ;IHS/DSD/ENM 01/06/98 OKCAO POC 12/15/97
.W !?5,"Where Dispensed: ",?21,$P(X,U,11)
.W !?5,"Sig:",?23,$P(X,U,7) ;IHS/DSD/ENM 09/06/96 CHNG 5 TO A 7
.W !?5,"Quantity:",?23,$P(X,U,8),?40,"Days Prescribed:",?58,$P(X,U,9) ;IHS/DSD/ENM 09/06/96 CHNG 6 TO 8, 7 TO 9
.W !?5,"DATE PRESCRIBED: ",$$FMTE^XLFDT($P(X,U,3)) ;IHS/DSD/ENM/POC 05/11/98
.Q
I '$D(APSPQUIT) S DIR("A")="End of Display. Hit return to continue" D PAUSE
D EXIT
Q
;
PAUSE ;
W ! S DIR(0)="E" D ^DIR K DIR W !
Q
HEAD ;write header
I 'APSPPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APSPQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF W !,"Outside Rx's for ",$P(^DPT(DFN,0),U)," from ",! S Y=APSPBD D DD^%DT W Y S Y=APSPED D DD^%DT W " to ",Y,":"
S APSPPG=APSPPG+1
Q
EXIT ;
K APSPBD,APSPED,APSPERR,APSPPG,APSPORX,APSPQUIT,APSPER,APSPY
K X,Y,%DT,DIR
D KILL^AUPNPAT
Q
APSPORXF ;IHS/DSD/ENM - FUNCTION CALLS FROM PCC ;09-Oct-2008 11:26;SM
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1007**;Sep 23, 2004
+2 ;
+3 ;Modified - IHS/MSC/PLS - 05/19/08 - Line MEDS+13
+4 ;function calls from pcc
MEDS(DFN,APSPA,APSPBD,APSPED,APSPSC,APSPVT) ;EP - GET MEDS IN DATE RANGE FOR A PATIENT, SCREEN OPTIONALLY ON SERV CAT OR TYPE
+1 NEW APSPX,APSPDFE,APSPDAT,APSPV,APSPVR,APSPI,APSPC,APSPR,APSPER
+2 SET APSPER=0
+3 ;no patient
IF 'DFN
SET APSPER=1
QUIT APSPER
+4 ;patient not valid
IF '$DATA(^DPT(DFN))
SET APSPER=1
QUIT APSPER
+5 ;no array defined
IF $GET(APSPA)=""
SET APSPER=2
QUIT APSPER
+6 IF $GET(APSPSC)=""
SET APSPSC=""
+7 IF $GET(APSPVT)=""
SET APSPVT=""
+8 ;set up data fetcher call
+9 SET APSPX=DFN_"^ALL MEDS"
Begin DoDot:1
+10 IF APSPED=""
SET APSPED=DT
+11 IF APSPBD]""!(APSPED]"")
SET APSPX=APSPX_";DURING "_APSPBD_"-"_APSPED
+12 QUIT
End DoDot:1
+13 ;IHS/MSC/PLS - 05/19/08 - Updated call to PCC
+14 ;S APSPDFE=$$^APCLDF(APSPX,"APSPDAT(")
+15 SET APSPDFE=$$START1^APCLDF(APSPX,"APSPDAT(")
+16 ;date fetcher error
IF APSPDFE
SET APSPER=3
QUIT APSPER
+17 IF '$DATA(APSPDAT)
QUIT APSPER
+18 SET (APSPX,APSPC)=0
FOR
SET APSPX=$ORDER(APSPDAT(APSPX))
IF APSPX'=+APSPX
QUIT
Begin DoDot:1
+19 SET APSPV=$PIECE(APSPDAT(APSPX),U,5)
SET APSPVR=^AUPNVSIT(APSPV,0)
+20 IF APSPSC]""
IF APSPSC'[$PIECE(APSPVR,U,7)
QUIT
+21 IF APSPVT]""
IF APSPVT'[$PIECE(APSPVR,U,3)
QUIT
+22 SET APSPI=+$PIECE(APSPDAT(APSPX),U,4)
SET APSPR=^AUPNVMED(APSPI,0)
+23 SET A=APSPA_APSPX_")"
SET @A=APSPI_U_APSPV_U_$PIECE(APSPDAT(APSPX),U)_U_$PIECE(APSPR,U)_U_$PIECE(APSPDAT(APSPX),U,2)
+24 FOR X=4:1:8
SET @A=@A_U_$PIECE(APSPR,U,X)
+25 SET @A=@A_U_$PIECE($GET(^AUPNVSIT(APSPV,21)),U)
+26 IF $GET(^AUPNVMED(APSPI,12))
FOR X=1:1:4
SET @A=@A_U_$PIECE(^AUPNVMED(APSPI,12),U,X)
+27 QUIT
End DoDot:1
+28 QUIT APSPER
+29 ;
START ;EP called from option to display all outside Rx/s
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!?18,"DISPLAY OUTSIDE RX's",!!
GETPAT ;
+1 ; get patient
DO GETPAT^APSPORXA
+2 IF 'DFN
DO EXIT
QUIT
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Date for Rx display"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETPAT
+3 SET APSPBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="D^"_APSPBD_":DT:EP"
SET DIR("A")="Enter ending Date for Rx display"
SET Y=APSPBD
DO DD^%DT
SET DIR("B")=Y
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APSPED=Y
+4 ;
GETMEDS ; get vmeds to display
+1 KILL APSPQUIT
+2 SET APSPERR=$$MEDS(DFN,"APSPORX(",APSPBD,APSPED,"E")
+3 IF APSPERR
WRITE !!,$CHAR(7),$CHAR(7),"Error occurred when attempting to find outside Rx's!! Notify supervisor"
DO PAUSE
GOTO EXIT
+4 IF '$DATA(APSPORX)
WRITE !!,$CHAR(7),"No Outside Rx's on file for ",$PIECE(^DPT(DFN,0),U),!,"in that time period",!
DO PAUSE
GOTO GETPAT
+5 SET APSPPG=0
DO HEAD
+6 SET APSPY=0
FOR
SET APSPY=$ORDER(APSPORX(APSPY))
IF APSPY'=+APSPY!($DATA(APSPQUIT))
QUIT
SET X=APSPORX(APSPY)
Begin DoDot:1
+7 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(APSPQUIT)
QUIT
+8 ;W !!,APSPY,")",?5,"Drug Name: ",?23,$S($P(X,U,5)]"":$P(X,U,5),1:$P(X,U,4))
+9 ;IHS/DSD/ENM 01/06/98 OKCAO POC 12/15/97
WRITE !!,APSPY,")",?5,"Drug Name: ",?23,$SELECT($PIECE(X,U,6)]"":$PIECE(X,U,6),1:$PIECE(X,U,5))
+10 WRITE !?5,"Where Dispensed: ",?21,$PIECE(X,U,11)
+11 ;IHS/DSD/ENM 09/06/96 CHNG 5 TO A 7
WRITE !?5,"Sig:",?23,$PIECE(X,U,7)
+12 ;IHS/DSD/ENM 09/06/96 CHNG 6 TO 8, 7 TO 9
WRITE !?5,"Quantity:",?23,$PIECE(X,U,8),?40,"Days Prescribed:",?58,$PIECE(X,U,9)
+13 ;IHS/DSD/ENM/POC 05/11/98
WRITE !?5,"DATE PRESCRIBED: ",$$FMTE^XLFDT($PIECE(X,U,3))
+14 QUIT
End DoDot:1
+15 IF '$DATA(APSPQUIT)
SET DIR("A")="End of Display. Hit return to continue"
DO PAUSE
+16 DO EXIT
+17 QUIT
+18 ;
PAUSE ;
+1 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !
+2 QUIT
HEAD ;write header
+1 IF 'APSPPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APSPQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
WRITE !,"Outside Rx's for ",$PIECE(^DPT(DFN,0),U)," from ",!
SET Y=APSPBD
DO DD^%DT
WRITE Y
SET Y=APSPED
DO DD^%DT
WRITE " to ",Y,":"
+2 SET APSPPG=APSPPG+1
+3 QUIT
EXIT ;
+1 KILL APSPBD,APSPED,APSPERR,APSPPG,APSPORX,APSPQUIT,APSPER,APSPY
+2 KILL X,Y,%DT,DIR
+3 DO KILL^AUPNPAT
+4 QUIT
