APSPORXA.m

APSPORXA ; IHS/DSD/ENM - enter outside rx ;  [ 02/20/2001  1:50 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;**1,3**;09/03/97

 ;

START ;EP - called from option

HDR ;write header

 W:$D(IOF) @IOF

 F J=1:1:7 S X=$P($T(TEXT+J),";;",2) W !?80-$L(X)\2,X

 K X,J

 W !!

 ;

BEGIN ;

 D INIT

 G:APSPQUIT EXIT

 D GETPAT

 G:DFN="" EXIT

 ;F  D GETDRUG Q:APSPQUIT!(APSPDIEN="")  D PROCESS

 ;F  D GETDRUG  Q:APSPQUIT!(APSPDIEN="")  D ^APSQDRG S:PSORX("DFLG") APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT)  D ^APSQDRDU S:$G(PSORX("DFLG")) APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT)  D PROCESS ;IHS/OKCAO/POC

 F  D GETDRUG  Q:APSPQUIT!(APSPDIEN="")  S X="APSQDRG" X ^%ZOSF("TEST") D:$T ^APSQDRG S:PSORX("DFLG") APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT)  D PROCESS ;IHS/OKCAO/POC

 D EXIT

 Q

PROCESS ;

 D GETDATE

 Q:APSPDATE=""

 D GETOL

 Q:APSPOL=""

 D GENVISIT

 Q:APSPQUIT

 D GENVMED

 Q

EXIT ;cleanup and exit

 K DFN,APCDLOOK,APCDANE,APCDALVR,APCDVSIT,APCDPAT

 K APSPOIEN,APSPDRUG,APSPDIEN,APSPOL,APSPDATE,APSPQUIT ;IHS/DSD/ENM APSPDOL REMOVED

 D KILL^AUPNPAT K AUPNTALK,AUPNLK("ALL")

 K DIE,DR,DA,DIRUT,DIR,DTOUT,DUOUT,DIV,DIW,DQ,DD,DQ,DI,DIC,DIR,X,Y,I,DDH,DI,D,D0

 Q

INIT ;EP

 S APSPQUIT=0

 S APSPOIEN=$O(^PSDRUG("B","OUTSIDE DRUG",0)) I 'APSPOIEN W !!,$C(7),$C(7),"OUTSIDE DRUG not defined in DRUG file, notify supervisor." H 3 S APSPQUIT=1 Q

 ;I APCDFLG S APSPQUIT=1 Q

 I '$D(PSOPAR) D ^PSOLSET ;set up pharmacy site parameters

 ;S APSPDOL=4472

 I '$G(APSPDOL) W !!,"DEFAULT OTHER LOCATION NOT DEFINED IN PHARMACY SITE FILE!!  NOTIFY YOUR SUPERVISOR" H 3 S APSPQUIT=1 Q

 Q

GETDATE ;EP GET DATE OF ENCOUNTER

 K DIR S APSPDATE="",DIR(0)="DO^:"_DT_":EPT",DIR("A")="Enter DATE DISPENSED" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 S %DT="ET" D ^%DT G:Y<0 GETDATE

 I Y>DT W "  <Future dates not allowed>",$C(7),$C(7) K X G GETDATE

 S APSPDATE=Y

 Q

GETOL ;

 S APSPOL=""

 S DIR(0)="9000010,2101",DIR("A")="Enter LOCATION WHERE DISPENSED" K DA D ^DIR K DIR

 S APSPOL=Y

 Q

GETDRUG ;

 S (APSPDRUG,APSPDIEN)=""

 W !! K DD,DIR S DIR(0)="FO^1:40",DIR("A")="Enter DRUG NAME" D ^DIR K DIR S:$D(DTOUT) DIRUT=1

 Q:Y=""

 I $D(DIRUT) W !,"No drug entered!!" Q

 S (X,APSPDRUG)=Y,DIC="^PSDRUG(",DIC(0)="MQE" D ^DIC K DIC

 I Y=-1 D NODRUG Q

 S APSPDIEN=+Y,APSPDRUG="" K DIR,DA,DIRUT,DTOUT,DUOUT

 Q

 ;

NODRUG ;

 W !,"That drug cannot be found in the Drug file."

 K DIR S DIR(0)="Y",DIR("A")="Do you want to try to lookup the drug in the Drug file again",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) W !,"Exiting..." S APSPQUIT=1 Q

 I Y G GETDRUG

 S APSPDIEN=APSPOIEN

 W ! K DD,DIR S DIR(0)="FO^1:40",DIR("A")="Enter the FULL DRUG NAME...",DIR("A",1)="You must enter the drug name that will appear on the health summary.",DIR("B")=APSPDRUG D ^DIR K DIR S:$D(DTOUT) DIRUT=1

 I $D(DIRUT) S APSPQUIT=1 W !!,"Exiting..." Q

 S APSPDRUG=Y

 S APSPDRUG=$TR(APSPDRUG,"-") ;IHS/OKCAO/POC 4/22/98

 Q

GENVISIT ;

 K APCDALVR

 S APCDALVR("AUPNTALK")=""

 S APCDALVR("APCDDATE")=APSPDATE

 S APCDALVR("APCDTYPE")="O"

 S APCDALVR("APCDPAT")=DFN

 S APCDALVR("APCDLOC")=$G(APSPDOL)

 S APCDALVR("APCDCAT")="E"

 S APCDALVR("APCDAUTO")="",APCDALVR("APCDANE")=""

 S APCDALVR("APCDOLOC")=APSPOL

 D ^APCDALV

 I $D(APCDALVR("APCDAFLG")) W !!,$C(7),"Creating PCC Visit Failed....Notify Supervisor" H 3 S APSPQUIT=1 Q

 S APCDVSIT=APCDALVR("APCDVSIT"),APCDPAT=APCDALVR("APCDPAT") S Y=DFN D ^AUPNPAT

 Q

GENVMED ;

 I '$G(APSPDIEN) W !!,"Error.... no drug entry" H 2 Q

 ;D ^APCDEA3

 W !!,"Please enter all available information about this prescription.",!

 S DA=APCDVSIT,DR="[APCD ORX (ADD)]",DIE="^AUPNVSIT(" D ^DIE

 I $D(Y) W !!,"Creating V Medication entry failed!!  Notify supervisor!" H 3 Q

 Q

GETPAT ;EP

 W !

 S DFN=""

 S DIC("A")="Enter PATIENT NAME:  ",DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S DFN=+Y

 ;ADD THESE 2 LINES TO BUILD DRUG ARRAY IHS/OKCAO/POC

 S PSODFN=+Y

 D ^PSOBUILD

 Q

 ;

TEXT ;

 ;;

 ;;IHS PHARMACY MODULE/PCC Interface

 ;;

 ;;*******************************

 ;;*    Entry of OUTSIDE RX's    *

 ;;*******************************

 ;;

APSPORXA  ; IHS/DSD/ENM - enter outside rx ;  [ 02/20/2001  1:50 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;**1,3**;09/03/97

 +2       ;

START     ;EP - called from option

HDR       ;write header

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        FOR J=1:1:7

               SET X=$PIECE($TEXT(TEXT+J),";;",2)

               WRITE !?80-$LENGTH(X)\2,X

 +3        KILL X,J

 +4        WRITE !!

 +5       ;

BEGIN     ;

 +1        DO INIT

 +2        IF APSPQUIT

               GOTO EXIT

 +3        DO GETPAT

 +4        IF DFN=""

               GOTO EXIT

 +5       ;F  D GETDRUG Q:APSPQUIT!(APSPDIEN="")  D PROCESS

 +6       ;F  D GETDRUG  Q:APSPQUIT!(APSPDIEN="")  D ^APSQDRG S:PSORX("DFLG") APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT)  D ^APSQDRDU S:$G(PSORX("DFLG")) APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT)  D PROCESS ;IHS/OKCAO/POC

 +7       ;IHS/OKCAO/POC

           FOR 

               DO GETDRUG

               IF APSPQUIT!(APSPDIEN="")

                   QUIT 

               SET X="APSQDRG"

               XECUTE ^%ZOSF("TEST")

               IF $TEST

                   DO ^APSQDRG

               IF PSORX("DFLG")

                   SET APSPQUIT=1

               KILL PSORX("DFLG")

               IF $GET(APSPQUIT)

                   QUIT 

               DO PROCESS

 +8        DO EXIT

 +9        QUIT 

PROCESS   ;

 +1        DO GETDATE

 +2        IF APSPDATE=""

               QUIT 

 +3        DO GETOL

 +4        IF APSPOL=""

               QUIT 

 +5        DO GENVISIT

 +6        IF APSPQUIT

               QUIT 

 +7        DO GENVMED

 +8        QUIT 

EXIT      ;cleanup and exit

 +1        KILL DFN,APCDLOOK,APCDANE,APCDALVR,APCDVSIT,APCDPAT

 +2       ;IHS/DSD/ENM APSPDOL REMOVED

           KILL APSPOIEN,APSPDRUG,APSPDIEN,APSPOL,APSPDATE,APSPQUIT

 +3        DO KILL^AUPNPAT

           KILL AUPNTALK,AUPNLK("ALL")

 +4        KILL DIE,DR,DA,DIRUT,DIR,DTOUT,DUOUT,DIV,DIW,DQ,DD,DQ,DI,DIC,DIR,X,Y,I,DDH,DI,D,D0

 +5        QUIT 

INIT      ;EP

 +1        SET APSPQUIT=0

 +2        SET APSPOIEN=$ORDER(^PSDRUG("B","OUTSIDE DRUG",0))

           IF 'APSPOIEN

               WRITE !!,$CHAR(7),$CHAR(7),"OUTSIDE DRUG not defined in DRUG file, notify supervisor."

               HANG 3

               SET APSPQUIT=1

               QUIT 

 +3       ;I APCDFLG S APSPQUIT=1 Q

 +4       ;set up pharmacy site parameters

           IF '$DATA(PSOPAR)

               DO ^PSOLSET

 +5       ;S APSPDOL=4472

 +6        IF '$GET(APSPDOL)

               WRITE !!,"DEFAULT OTHER LOCATION NOT DEFINED IN PHARMACY SITE FILE!!  NOTIFY YOUR SUPERVISOR"

               HANG 3

               SET APSPQUIT=1

               QUIT 

 +7        QUIT 

GETDATE   ;EP GET DATE OF ENCOUNTER

 +1        KILL DIR

           SET APSPDATE=""

           SET DIR(0)="DO^:"_DT_":EPT"

           SET DIR("A")="Enter DATE DISPENSED"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               QUIT 

 +3        SET %DT="ET"

           DO ^%DT

           IF Y<0

               GOTO GETDATE

 +4        IF Y>DT

               WRITE "  <Future dates not allowed>",$CHAR(7),$CHAR(7)

               KILL X

               GOTO GETDATE

 +5        SET APSPDATE=Y

 +6        QUIT 

GETOL     ;

 +1        SET APSPOL=""

 +2        SET DIR(0)="9000010,2101"

           SET DIR("A")="Enter LOCATION WHERE DISPENSED"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        SET APSPOL=Y

 +4        QUIT 

GETDRUG   ;

 +1        SET (APSPDRUG,APSPDIEN)=""

 +2        WRITE !!

           KILL DD,DIR

           SET DIR(0)="FO^1:40"

           SET DIR("A")="Enter DRUG NAME"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)

               SET DIRUT=1

 +3        IF Y=""

               QUIT 

 +4        IF $DATA(DIRUT)

               WRITE !,"No drug entered!!"

               QUIT 

 +5        SET (X,APSPDRUG)=Y

           SET DIC="^PSDRUG("

           SET DIC(0)="MQE"

           DO ^DIC

           KILL DIC

 +6        IF Y=-1

               DO NODRUG

               QUIT 

 +7        SET APSPDIEN=+Y

           SET APSPDRUG=""

           KILL DIR,DA,DIRUT,DTOUT,DUOUT

 +8        QUIT 

 +9       ;

NODRUG    ;

 +1        WRITE !,"That drug cannot be found in the Drug file."

 +2        KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Do you want to try to lookup the drug in the Drug file again"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               WRITE !,"Exiting..."

               SET APSPQUIT=1

               QUIT 

 +4        IF Y

               GOTO GETDRUG

 +5        SET APSPDIEN=APSPOIEN

 +6        WRITE !

           KILL DD,DIR

           SET DIR(0)="FO^1:40"

           SET DIR("A")="Enter the FULL DRUG NAME..."

           SET DIR("A",1)="You must enter the drug name that will appear on the health summary."

           SET DIR("B")=APSPDRUG

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)

               SET DIRUT=1

 +7        IF $DATA(DIRUT)

               SET APSPQUIT=1

               WRITE !!,"Exiting..."

               QUIT 

 +8        SET APSPDRUG=Y

 +9       ;IHS/OKCAO/POC 4/22/98

           SET APSPDRUG=$TRANSLATE(APSPDRUG,"-")

 +10       QUIT 

GENVISIT  ;

 +1        KILL APCDALVR

 +2        SET APCDALVR("AUPNTALK")=""

 +3        SET APCDALVR("APCDDATE")=APSPDATE

 +4        SET APCDALVR("APCDTYPE")="O"

 +5        SET APCDALVR("APCDPAT")=DFN

 +6        SET APCDALVR("APCDLOC")=$GET(APSPDOL)

 +7        SET APCDALVR("APCDCAT")="E"

 +8        SET APCDALVR("APCDAUTO")=""

           SET APCDALVR("APCDANE")=""

 +9        SET APCDALVR("APCDOLOC")=APSPOL

 +10       DO ^APCDALV

 +11       IF $DATA(APCDALVR("APCDAFLG"))

               WRITE !!,$CHAR(7),"Creating PCC Visit Failed....Notify Supervisor"

               HANG 3

               SET APSPQUIT=1

               QUIT 

 +12       SET APCDVSIT=APCDALVR("APCDVSIT")

           SET APCDPAT=APCDALVR("APCDPAT")

           SET Y=DFN

           DO ^AUPNPAT

 +13       QUIT 

GENVMED   ;

 +1        IF '$GET(APSPDIEN)

               WRITE !!,"Error.... no drug entry"

               HANG 2

               QUIT 

 +2       ;D ^APCDEA3

 +3        WRITE !!,"Please enter all available information about this prescription.",!

 +4        SET DA=APCDVSIT

           SET DR="[APCD ORX (ADD)]"

           SET DIE="^AUPNVSIT("

           DO ^DIE

 +5        IF $DATA(Y)

               WRITE !!,"Creating V Medication entry failed!!  Notify supervisor!"

               HANG 3

               QUIT 

 +6        QUIT 

GETPAT    ;EP

 +1        WRITE !

 +2        SET DFN=""

 +3        SET DIC("A")="Enter PATIENT NAME:  "

           SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +4        IF Y<0

               QUIT 

 +5        SET DFN=+Y

 +6       ;ADD THESE 2 LINES TO BUILD DRUG ARRAY IHS/OKCAO/POC

 +7        SET PSODFN=+Y

 +8        DO ^PSOBUILD

 +9        QUIT 

 +10      ;

TEXT      ;

 +1       ;;

 +2       ;;IHS PHARMACY MODULE/PCC Interface

 +3       ;;

 +4       ;;*******************************

 +5       ;;*    Entry of OUTSIDE RX's    *

 +6       ;;*******************************

 +7       ;;