APSPVST1.m

APSPVST1 ; IHS/DSD/ENM - CREATE PCC NEW RX LINKAGE ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ; Only called from APSPVST to create linkage in real time not

 ; background.

 ;

START S APSPVST1=APSPVST("RX0"),(APSPVST1("VMDFN"),APSPVST1("VDFN"))=""

VISIT I '$D(APCDALVR("APCDVSIT")) D GVISIT G:'$D(APCDALVR("APCDVSIT")) EXIT S APSPVST1("VDFN")=APCDALVR("APCDVSIT")

VMED K APCDALVR("APCDADFN") D GVMED G:'$D(APCDALVR("APCDADFN")) EXIT S APSPVST1("VMDFN")=APCDALVR("APCDADFN")

RX ;

 I 'APSPVST("RFN"),$D(^PSRX(APSPVST("IRXN"))) NEW DIE,DR,DA S DIE="^PSRX(",DR="9999999.11////"_APCDALVR("APCDADFN"),DA=APSPVST("IRXN") D ^DIE K DA,DIE,DR ;IHS/OHPRD/JCM 6/11/90

 I APSPVST("RFN"),$D(^PSRX(APSPVST("IRXN"),1,APSPVST("RFN"))) N DR,DA,DIE S DIE="^PSRX(APSPVST(""IRXN""),1,",DA(1)=APSPVST("IRXN"),DA=APSPVST("RFN"),DR="9999999.11////"_APCDALVR("APCDADFN") D ^DIE K DIE,DA,DR ;IHS/OHPRD/JCM 6/11/90

EXIT ;

 K APSPVST1,X,Y

 Q

 ;

GVISIT ;

 ;W !,"Creating a visit to which prescriptions will link .. "

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

 S AUPNTALK=""

 D ^APCDALV

 K APCDALVR("APCDAUTO"),APCDALVR("APCDANE"),AUPNTALK

 G:$D(APCDALVR("APCDAFLG")) @("V"_APCDALVR("APCDAFLG"))

 Q

 ;

GVMED ;

 S APCDALVR("APCDTRX")="`"_$P(APSPVST1,U,6)

 S X=$P(APSPVST1,U,10),APCDALVR("APCDTSIG")=$S($L(X)<33:X,1:$E(X,1,31)_"~")

 S APCDALVR("APCDTQTY")=+$P(APSPVST1,U,7)\1

 S APCDALVR("APCDTDAY")=$P(APSPVST1,U,8)

 S APCDALVR("APCDTDIS")=""

 ;

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.14 (ADD)]"

 K APCDALVR("APCDAFLG")

 D ^APCDALVR

 G:$D(APCDALVR("APCDAFLG")) @APCDALVR("APCDAFLG")

 Q

 ;

V2 S APSPVST1("ERROR")="inability to create visit",APSPVST1("BN")="V" G LBULL

V3 S APSPVST1("ERROR")="invalid visit parameters (date, location, etc.)",APSPVST1("BN")="V" G LBULL

 ;

1 S APSPVST1("ERROR")="incorrect template specification",APSPVST1("BN")="VMED" G LBULL

2 S APSPVST1("ERROR")="invalid values being passed to V MED",APSPVST1("BN")="VMED" G LBULL

 ;

LBULL ; SEND BULLETIN - LINK FAILURE

 W !,"ERROR HAS OCCURED RX DFN= ",+APSPVST1

 K XMB

 S XMB(1)=+APSPVST1

 S XMB(2)=$P(^DPT(APSPVST("PSDFN"),0),U,1)_" (DFN "_APSPVST("PSDFN")_")"

 S XMB(3)=$S(APSPVST("RFN")=0:"established",1:"refilled")

 S Y=DT X ^DD("DD")

 S XMB(4)=Y

 S XMB(5)=APSPVST1("ERROR")

 S XMB="APSP LINK FAIL "_APSPVST1("BN")

 S APSPVST("DUZ")=DUZ,DUZ=.5 D ^XMB S DUZ=APSPVST("DUZ") K XMB,APSPVST("DUZ"),APSPVST1("ERROR"),APSPVST1("BN")

 Q

APSPVST1  ; IHS/DSD/ENM - CREATE PCC NEW RX LINKAGE ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ; Only called from APSPVST to create linkage in real time not

 +3       ; background.

 +4       ;

START      SET APSPVST1=APSPVST("RX0")

           SET (APSPVST1("VMDFN"),APSPVST1("VDFN"))=""

VISIT      IF '$DATA(APCDALVR("APCDVSIT"))

               DO GVISIT

               IF '$DATA(APCDALVR("APCDVSIT"))

                   GOTO EXIT

               SET APSPVST1("VDFN")=APCDALVR("APCDVSIT")

VMED       KILL APCDALVR("APCDADFN")

           DO GVMED

           IF '$DATA(APCDALVR("APCDADFN"))

               GOTO EXIT

           SET APSPVST1("VMDFN")=APCDALVR("APCDADFN")

RX        ;

 +1       ;IHS/OHPRD/JCM 6/11/90

           IF 'APSPVST("RFN")

               IF $DATA(^PSRX(APSPVST("IRXN")))

                   NEW DIE,DR,DA

                   SET DIE="^PSRX("

                   SET DR="9999999.11////"_APCDALVR("APCDADFN")

                   SET DA=APSPVST("IRXN")

                   DO ^DIE

                   KILL DA,DIE,DR

 +2       ;IHS/OHPRD/JCM 6/11/90

           IF APSPVST("RFN")

               IF $DATA(^PSRX(APSPVST("IRXN"),1,APSPVST("RFN")))

                   NEW DR,DA,DIE

                   SET DIE="^PSRX(APSPVST(""IRXN""),1,"

                   SET DA(1)=APSPVST("IRXN")

                   SET DA=APSPVST("RFN")

                   SET DR="9999999.11////"_APCDALVR("APCDADFN")

                   DO ^DIE

                   KILL DIE,DA,DR

EXIT      ;

 +1        KILL APSPVST1,X,Y

 +2        QUIT 

 +3       ;

GVISIT    ;

 +1       ;W !,"Creating a visit to which prescriptions will link .. "

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

           SET APCDALVR("APCDANE")=""

 +3        SET AUPNTALK=""

 +4        DO ^APCDALV

 +5        KILL APCDALVR("APCDAUTO"),APCDALVR("APCDANE"),AUPNTALK

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

               GOTO @("V"_APCDALVR("APCDAFLG"))

 +7        QUIT 

 +8       ;

GVMED     ;

 +1        SET APCDALVR("APCDTRX")="`"_$PIECE(APSPVST1,U,6)

 +2        SET X=$PIECE(APSPVST1,U,10)

           SET APCDALVR("APCDTSIG")=$SELECT($LENGTH(X)<33:X,1:$EXTRACT(X,1,31)_"~")

 +3        SET APCDALVR("APCDTQTY")=+$PIECE(APSPVST1,U,7)\1

 +4        SET APCDALVR("APCDTDAY")=$PIECE(APSPVST1,U,8)

 +5        SET APCDALVR("APCDTDIS")=""

 +6       ;

 +7        SET APCDALVR("APCDATMP")="[APCDALVR 9000010.14 (ADD)]"

 +8        KILL APCDALVR("APCDAFLG")

 +9        DO ^APCDALVR

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

               GOTO @APCDALVR("APCDAFLG")

 +11       QUIT 

 +12      ;

V2         SET APSPVST1("ERROR")="inability to create visit"

           SET APSPVST1("BN")="V"

           GOTO LBULL

V3         SET APSPVST1("ERROR")="invalid visit parameters (date, location, etc.)"

           SET APSPVST1("BN")="V"

           GOTO LBULL

 +1       ;

1          SET APSPVST1("ERROR")="incorrect template specification"

           SET APSPVST1("BN")="VMED"

           GOTO LBULL

2          SET APSPVST1("ERROR")="invalid values being passed to V MED"

           SET APSPVST1("BN")="VMED"

           GOTO LBULL

 +1       ;

LBULL     ; SEND BULLETIN - LINK FAILURE

 +1        WRITE !,"ERROR HAS OCCURED RX DFN= ",+APSPVST1

 +2        KILL XMB

 +3        SET XMB(1)=+APSPVST1

 +4        SET XMB(2)=$PIECE(^DPT(APSPVST("PSDFN"),0),U,1)_" (DFN "_APSPVST("PSDFN")_")"

 +5        SET XMB(3)=$SELECT(APSPVST("RFN")=0:"established",1:"refilled")

 +6        SET Y=DT

           XECUTE ^DD("DD")

 +7        SET XMB(4)=Y

 +8        SET XMB(5)=APSPVST1("ERROR")

 +9        SET XMB="APSP LINK FAIL "_APSPVST1("BN")

 +10       SET APSPVST("DUZ")=DUZ

           SET DUZ=.5

           DO ^XMB

           SET DUZ=APSPVST("DUZ")

           KILL XMB,APSPVST("DUZ"),APSPVST1("ERROR"),APSPVST1("BN")

 +11       QUIT