APSPSITE ;IHS/CIA/PLS - IHS Site Parameter Setup;04-Nov-2011 08:52;PLS
;;7.0;IHS PHARMACY MODIFICATIONS;**1003,1008,1009,1013**;Sep 23, 2004;Build 33
; Modified - IHS/CIA/PLS - 04/05/05 - SIGLBL API
; IHS/MSC/PLS - 03/17/09 - PDEDWM commented out
; - Added PMIS printer default
; 06/29/10 - Added default label device support
EP ; EP
; APSQSGLB - Holds the selected signature label device when using laser labels.
I $D(^APSPCTRL(PSOSITE,0)) S %APSITE=^(0)
S %APSITE3=$G(^APSPCTRL(PSOSITE,3)),APSQTYPE=$P($G(^(3)),"^",1) ; Patient Info Language
I $P($G(%APSITE),U,36)]"" S $P(%APSITE,U,20)=$P(%APSITE,U,36) ; Summary Label Copies
S $P(%APSITE,U,15)="",$P(%APSITE,U,36)=""
S APSPMAN=$P($G(^APSPCTRL(PSOSITE,1)),U) ; Manufacturer
;USED IN FILLING RX AND REFILLS TO LIMIT FIELDS SEEN
S PSOAWP=+$P(%APSITE3,"^",9)
S PSOCOST=+$P(%APSITE3,"^",10)
S PSONDC=$P(%APSITE3,"^",8)
S PSOPATST=$P(%APSITE3,"^",2)
S PSOBILST=$P(%APSITE3,"^",4) S:PSOBILST="" PSOBILST=0
S PSOBILRX=$P(%APSITE3,"^",5)
S APSQDNDC=$P(%APSITE3,"^",11) ; Display NDC on label
S PSOTRIP=$P(%APSITE3,"^",12) ;Triplicate number
S APSPCMP=+$P(%APSITE3,U,13) ;Chronic Med Prompt
S APSPDOL=$P($G(^APSPCTRL(PSOSITE,1)),U,2) ; Default other location set
I $D(^AUTTSITE(1,0)),$P(^(0),U,8)="Y",'$D(^APCCCTRL(DUZ(2),0))#2 W !,*7,"ENTRY MUST BE MADE IN THE PCC MASTER CONTROL FILE FOR THIS LOCATION",!,"PLEASE NOTIFY YOUR SITE MANAGER ... NO LINKAGE TO PCC IS OCCURRING !"
S PHARMACY("PKGE DFN")=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",""))
I $P(%APSITE,U,36)]"",'$D(^APCCCTRL(DUZ(2),11,PHARMACY("PKGE DFN"),0))#2 W !,*7,"ENTRY MUST BE MADE IN THE PCC MASTER CONTROL FILE FOR THIS PACKAGE !",!,"PLEASE NOTIFY YOUR SITE MANAGER ... NO LINKAGE TO PCC IS OCCURRING !"
I $D(^AUTTSITE(1,0)),$P(^(0),U,8)="Y",$D(^APCCCTRL(DUZ(2),0))#2,$D(^APCCCTRL(DUZ(2),11,PHARMACY("PKGE DFN"),0))#2,$P(^(0),U,2) S $P(%APSITE,U,15)="Y",$P(%APSITE,U,36)=$P(^APCCCTRL(DUZ(2),0),U,2)
S APSPLAP=$$GET1^DIQ(9009033,PSOSITE,401)
K PHARMACY("PKGE DFN")
;-----------------------------------------------------------------
PDEDWM ; Patient Drug Education Database expiration warning message
;IHS/MSC/PLS - 03/17/09 - VA PMI data is now used.
;S X="APSEWMSG" X ^%ZOSF("TEST") I $T D EP^APSEWMSG
;
;-----------------------------------------------------------------
CPARM ; Chronic Med Parameter Default Days
S PSOZZCP("DAYS")=""
K PSOZP("FLG"),DIRUT,DTOUT
S DIR(0)="NO^1:999:0"
S DIR("B")=90,DIR("A")="Number of Days For Chronic Med Profile"
D ^DIR
I $D(DIRUT)!($D(DTOUT)) S PSOZCP("FLG")="" G CPARMX
S PSOZZCP("DAYS")=$S(+Y>0:+Y,1:90)
CPARMX ;-----------------------------------------------------------------
S PSODIV=$S(($P(PSOSYS,"^",2))&('$P(PSOSYS,"^",3)):0,1:1)
S PSOINST=000 I $D(^DD("SITE",1)) S PSOINST=^DD("SITE",1)
I $D(DUZ),$D(^VA(200,+DUZ,0)) S PSOCLC=DUZ
I $D(PSOREO) G EXIT ;No printer questions for OREO
;-----------------------------------------------------------------
ZCM ; Chronic Med Queue
W !,"Pre-Select PMI/Chronic Med Profile Device? (Y/N) "
S %=2 D YN^DICN
W:%Y["?" !,"Answer 'Yes' if you want the Chronic Med Profiles to automa tically print with new Rx's"
G:%Y["?" ZCM
S APSPCP=%
CPLBL ; Chronic Med Device
I APSPCP=1 D
.S %ZIS="MNQ",%ZIS("A")="Select PMI/Chronic Med Profile PRINTER: "
.S:$L($$GET1^DIQ(59.7,1,13)) %ZIS("B")=$$GET1^DIQ(59.7,1,13)
.D ^%ZIS K %ZIS,IO("Q"),IOP
.Q:POP
.S APSPCPP=ION D ^%ZISC
; Signature Label Device
SIGLBL S APSQSGLB=""
; IHS/CIA/PLS - 04/05/05 - Logic changed to always prompt for signature label per PSG
;I $$GET1^DIQ(9009033,PSOSITE,316,"I") D
;.N APSPSIG,POP,%ZIS,ION
;.S APSPSIG=$$GET1^DIQ(9009033,PSOSITE,306,"I")
;.Q:'$L(APSPSIG)!(APSPSIG["N")
;.S %ZIS="MNQ",%ZIS("A")="Select Signature Label Printer: //"
;.S %ZIS("B")=""
;.S %ZIS("S")="I $P(^(0),U,2)'=0,$E($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0)),1)=""P"""
;.D ^%ZIS K IO("Q") Q:POP S APSQSGLB=ION_U_$G(IO("S")) D ^%ZISC
N APSPSIG,POP,%ZIS,ION
S APSPSIG=$$GET1^DIQ(9009033,PSOSITE,306,"I")
Q:'$L(APSPSIG)!(APSPSIG["N")
S %ZIS="MNQ",%ZIS("A")="Select Signature Label Printer: //"
S %ZIS("B")=""
S %ZIS("S")="I $P(^(0),U,2)'=0,$E($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0)),1)=""P"""
D ^%ZIS K IO("Q") Q:POP S APSQSGLB=ION_U_$G(IO("S")) D ^%ZISC
EXIT Q
APSPSITE ;IHS/CIA/PLS - IHS Site Parameter Setup;04-Nov-2011 08:52;PLS
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1003,1008,1009,1013**;Sep 23, 2004;Build 33
+2 ; Modified - IHS/CIA/PLS - 04/05/05 - SIGLBL API
+3 ; IHS/MSC/PLS - 03/17/09 - PDEDWM commented out
+4 ; - Added PMIS printer default
+5 ; 06/29/10 - Added default label device support
EP ; EP
+1 ; APSQSGLB - Holds the selected signature label device when using laser labels.
+2 IF $DATA(^APSPCTRL(PSOSITE,0))
SET %APSITE=^(0)
+3 ; Patient Info Language
SET %APSITE3=$GET(^APSPCTRL(PSOSITE,3))
SET APSQTYPE=$PIECE($GET(^(3)),"^",1)
+4 ; Summary Label Copies
IF $PIECE($GET(%APSITE),U,36)]""
SET $PIECE(%APSITE,U,20)=$PIECE(%APSITE,U,36)
+5 SET $PIECE(%APSITE,U,15)=""
SET $PIECE(%APSITE,U,36)=""
+6 ; Manufacturer
SET APSPMAN=$PIECE($GET(^APSPCTRL(PSOSITE,1)),U)
+7 ;USED IN FILLING RX AND REFILLS TO LIMIT FIELDS SEEN
+8 SET PSOAWP=+$PIECE(%APSITE3,"^",9)
+9 SET PSOCOST=+$PIECE(%APSITE3,"^",10)
+10 SET PSONDC=$PIECE(%APSITE3,"^",8)
+11 SET PSOPATST=$PIECE(%APSITE3,"^",2)
+12 SET PSOBILST=$PIECE(%APSITE3,"^",4)
IF PSOBILST=""
SET PSOBILST=0
+13 SET PSOBILRX=$PIECE(%APSITE3,"^",5)
+14 ; Display NDC on label
SET APSQDNDC=$PIECE(%APSITE3,"^",11)
+15 ;Triplicate number
SET PSOTRIP=$PIECE(%APSITE3,"^",12)
+16 ;Chronic Med Prompt
SET APSPCMP=+$PIECE(%APSITE3,U,13)
+17 ; Default other location set
SET APSPDOL=$PIECE($GET(^APSPCTRL(PSOSITE,1)),U,2)
+18 IF $DATA(^AUTTSITE(1,0))
IF $PIECE(^(0),U,8)="Y"
IF '$DATA(^APCCCTRL(DUZ(2),0))#2
WRITE !,*7,"ENTRY MUST BE MADE IN THE PCC MASTER CONTROL FILE FOR THIS LOCATION",!,"PLEASE NOTIFY YOUR SITE MANAGER ... NO LINKAGE TO PCC IS OCCURRING !"
+19 SET PHARMACY("PKGE DFN")=$ORDER(^DIC(9.4,"B","OUTPATIENT PHARMACY",""))
+20 IF $PIECE(%APSITE,U,36)]""
IF '$DATA(^APCCCTRL(DUZ(2),11,PHARMACY("PKGE DFN"),0))#2
WRITE !,*7,"ENTRY MUST BE MADE IN THE PCC MASTER CONTROL FILE FOR THIS PACKAGE !",!,"PLEASE NOTIFY YOUR SITE MANAGER ... NO LINKAGE TO PCC IS OCCURRING !"
+21 IF $DATA(^AUTTSITE(1,0))
IF $PIECE(^(0),U,8)="Y"
IF $DATA(^APCCCTRL(DUZ(2),0))#2
IF $DATA(^APCCCTRL(DUZ(2),11,PHARMACY("PKGE DFN"),0))#2
IF $PIECE(^(0),U,2)
SET $PIECE(%APSITE,U,15)="Y"
SET $PIECE(%APSITE,U,36)=$PIECE(^APCCCTRL(DUZ(2),0),U,2)
+22 SET APSPLAP=$$GET1^DIQ(9009033,PSOSITE,401)
+23 KILL PHARMACY("PKGE DFN")
+24 ;-----------------------------------------------------------------
PDEDWM ; Patient Drug Education Database expiration warning message
+1 ;IHS/MSC/PLS - 03/17/09 - VA PMI data is now used.
+2 ;S X="APSEWMSG" X ^%ZOSF("TEST") I $T D EP^APSEWMSG
+3 ;
+4 ;-----------------------------------------------------------------
CPARM ; Chronic Med Parameter Default Days
+1 SET PSOZZCP("DAYS")=""
+2 KILL PSOZP("FLG"),DIRUT,DTOUT
+3 SET DIR(0)="NO^1:999:0"
+4 SET DIR("B")=90
SET DIR("A")="Number of Days For Chronic Med Profile"
+5 DO ^DIR
+6 IF $DATA(DIRUT)!($DATA(DTOUT))
SET PSOZCP("FLG")=""
GOTO CPARMX
+7 SET PSOZZCP("DAYS")=$SELECT(+Y>0:+Y,1:90)
CPARMX ;-----------------------------------------------------------------
+1 SET PSODIV=$SELECT(($PIECE(PSOSYS,"^",2))&('$PIECE(PSOSYS,"^",3)):0,1:1)
+2 SET PSOINST=000
IF $DATA(^DD("SITE",1))
SET PSOINST=^DD("SITE",1)
+3 IF $DATA(DUZ)
IF $DATA(^VA(200,+DUZ,0))
SET PSOCLC=DUZ
+4 ;No printer questions for OREO
IF $DATA(PSOREO)
GOTO EXIT
+5 ;-----------------------------------------------------------------
ZCM ; Chronic Med Queue
+1 WRITE !,"Pre-Select PMI/Chronic Med Profile Device? (Y/N) "
+2 SET %=2
DO YN^DICN
+3 IF %Y["?"
WRITE !,"Answer 'Yes' if you want the Chronic Med Profiles to automa tically print with new Rx's"
+4 IF %Y["?"
GOTO ZCM
+5 SET APSPCP=%
CPLBL ; Chronic Med Device
+1 IF APSPCP=1
Begin DoDot:1
+2 SET %ZIS="MNQ"
SET %ZIS("A")="Select PMI/Chronic Med Profile PRINTER: "
+3 IF $LENGTH($$GET1^DIQ(59.7,1,13))
SET %ZIS("B")=$$GET1^DIQ(59.7,1,13)
+4 DO ^%ZIS
KILL %ZIS,IO("Q"),IOP
+5 IF POP
QUIT
+6 SET APSPCPP=ION
DO ^%ZISC
End DoDot:1
+7 ; Signature Label Device
SIGLBL SET APSQSGLB=""
+1 ; IHS/CIA/PLS - 04/05/05 - Logic changed to always prompt for signature label per PSG
+2 ;I $$GET1^DIQ(9009033,PSOSITE,316,"I") D
+3 ;.N APSPSIG,POP,%ZIS,ION
+4 ;.S APSPSIG=$$GET1^DIQ(9009033,PSOSITE,306,"I")
+5 ;.Q:'$L(APSPSIG)!(APSPSIG["N")
+6 ;.S %ZIS="MNQ",%ZIS("A")="Select Signature Label Printer: //"
+7 ;.S %ZIS("B")=""
+8 ;.S %ZIS("S")="I $P(^(0),U,2)'=0,$E($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0)),1)=""P"""
+9 ;.D ^%ZIS K IO("Q") Q:POP S APSQSGLB=ION_U_$G(IO("S")) D ^%ZISC
+10 NEW APSPSIG,POP,%ZIS,ION
+11 SET APSPSIG=$$GET1^DIQ(9009033,PSOSITE,306,"I")
+12 IF '$LENGTH(APSPSIG)!(APSPSIG["N")
QUIT
+13 SET %ZIS="MNQ"
SET %ZIS("A")="Select Signature Label Printer: //"
+14 SET %ZIS("B")=""
+15 SET %ZIS("S")="I $P(^(0),U,2)'=0,$E($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0)),1)=""P"""
+16 DO ^%ZIS
KILL IO("Q")
IF POP
QUIT
SET APSQSGLB=ION_U_$GET(IO("S"))
DO ^%ZISC
EXIT QUIT
