- 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
