APSDALVN.m

APSDALVN ;IHS/DSD/ENM/JCM ; CREATE PCC NEW RX LINKAGE ; [ 05/14/1998   4:04 PM ]

 ;;V6.0;IHS PHARMACY MODIFICATIONS;**1**;09/03/97

 ;;V5.06;APSP;MAY 07, 1990

 ; NOTE: CALLED FROM APSDALV1

 ;

 S %=APSRX0

 D ^APSPCCP

 ;S APCDALVR("APCDDATE")=$P(%,U,13)

VISIT I '$D(APCDALVR("APCDVSIT")) D GVISIT G:'$D(APCDALVR("APCDVSIT")) EXIT

VMED K APCDALVR("APCDADFN") D GVMED G:'$D(APCDALVR("APCDADFN")) EXIT

RX ;

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

EXIT K %

 Q

 ;

GVISIT ;

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

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

 S AUPNTALK=""

 S:$D(^APSPCCTM) (^APSPCCTM,APSPCCTM)=^APSPCCTM+1,^APSPCCTM(APSPCCTM,1)=$H_"^V"

 D ^APCDALV

 I $D(APSPCCTM) S ^APSPCCTM(APSPCCTM,2)=$H K APSPCCTM

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

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

 Q

 ;

GVMED ;

 S %=APSRX0

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

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

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

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

 S APCDALVR("APCDTDIS")=""

 ;

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

 K APCDALVR("APCDAFLG")

 S:$D(^APSPCCTM) (^APSPCCTM,APSPCCTM)=^APSPCCTM+1,^APSPCCTM(APSPCCTM,1)=$H_"^N"

 D ^APCDALVR

 I $D(APSPCCTM) S ^APSPCCTM(APSPCCTM,2)=$H K APSPCCTM

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

 Q

 ;

V2 S APSERROR="inability to create visit",APSBN="V" G LBULL

V3 S APSERROR="invalid visit parameters (date, location, etc.)",APSBN="V" G LBULL

 ;

1 S APSERROR="incorrect template specification",APSBN="VMED" G LBULL

2 S APSERROR="invalid values being passed to V MED",APSBN="VMED" G LBULL

 ;

LBULL ; SEND BULLETIN - LINK FAILURE

 K XMB

 S XMB(1)=+APSRX0

 S APSPAT=$P(APSRX0,U,2)

 S XMB(2)=$P(^DPT(APSPAT,0),U,1)_" (DFN "_APSPAT_")"

 S XMB(3)="established"

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

 S XMB(4)=Y

 S XMB(5)=APSERROR

 S XMB="APSP LINK FAIL "_APSBN

 S APSDUZ=DUZ,DUZ=.5 D ^XMB S DUZ=APSDUZ K XMB,APSDUZ,APSERROR,APSBN,APSPAT

 Q

APSDALVN  ;IHS/DSD/ENM/JCM ; CREATE PCC NEW RX LINKAGE ; [ 05/14/1998   4:04 PM ]

 +1       ;;V6.0;IHS PHARMACY MODIFICATIONS;**1**;09/03/97

 +2       ;;V5.06;APSP;MAY 07, 1990

 +3       ; NOTE: CALLED FROM APSDALV1

 +4       ;

 +5        SET %=APSRX0

 +6        DO ^APSPCCP

 +7       ;S APCDALVR("APCDDATE")=$P(%,U,13)

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

               DO GVISIT

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

                   GOTO EXIT

VMED       KILL APCDALVR("APCDADFN")

           DO GVMED

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

               GOTO EXIT

RX        ;

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

           IF $DATA(^PSRX(APSRX))

               IF APCDALVR("APCDADFN")

                   NEW DIE,DR,DA

                   SET DIE="^PSRX("

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

                   SET DA=APSRX

                   DO ^DIE

                   KILL DA,DIE,DR

EXIT       KILL %

 +1        QUIT 

 +2       ;

GVISIT    ;

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

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

           SET APCDALVR("APCDANE")=""

 +3        SET AUPNTALK=""

 +4        IF $DATA(^APSPCCTM)

               SET (^APSPCCTM,APSPCCTM)=^APSPCCTM+1

               SET ^APSPCCTM(APSPCCTM,1)=$HOROLOG_"^V"

 +5        DO ^APCDALV

 +6        IF $DATA(APSPCCTM)

               SET ^APSPCCTM(APSPCCTM,2)=$HOROLOG

               KILL APSPCCTM

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

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

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

 +9        QUIT 

 +10      ;

GVMED     ;

 +1        SET %=APSRX0

 +2        SET APCDALVR("APCDTRX")="`"_$PIECE(%,U,6)

 +3        SET X=$PIECE(%,U,10)

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

 +4        SET APCDALVR("APCDTQTY")=+$PIECE(%,U,7)\1

 +5        SET APCDALVR("APCDTDAY")=$PIECE(%,U,8)

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

 +7       ;

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

 +9        KILL APCDALVR("APCDAFLG")

 +10       IF $DATA(^APSPCCTM)

               SET (^APSPCCTM,APSPCCTM)=^APSPCCTM+1

               SET ^APSPCCTM(APSPCCTM,1)=$HOROLOG_"^N"

 +11       DO ^APCDALVR

 +12       IF $DATA(APSPCCTM)

               SET ^APSPCCTM(APSPCCTM,2)=$HOROLOG

               KILL APSPCCTM

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

               GOTO @APCDALVR("APCDAFLG")

 +14       QUIT 

 +15      ;

V2         SET APSERROR="inability to create visit"

           SET APSBN="V"

           GOTO LBULL

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

           SET APSBN="V"

           GOTO LBULL

 +1       ;

1          SET APSERROR="incorrect template specification"

           SET APSBN="VMED"

           GOTO LBULL

2          SET APSERROR="invalid values being passed to V MED"

           SET APSBN="VMED"

           GOTO LBULL

 +1       ;

LBULL     ; SEND BULLETIN - LINK FAILURE

 +1        KILL XMB

 +2        SET XMB(1)=+APSRX0

 +3        SET APSPAT=$PIECE(APSRX0,U,2)

 +4        SET XMB(2)=$PIECE(^DPT(APSPAT,0),U,1)_" (DFN "_APSPAT_")"

 +5        SET XMB(3)="established"

 +6        SET Y=DT

           XECUTE ^DD("DD")

 +7        SET XMB(4)=Y

 +8        SET XMB(5)=APSERROR

 +9        SET XMB="APSP LINK FAIL "_APSBN

 +10       SET APSDUZ=DUZ

           SET DUZ=.5

           DO ^XMB

           SET DUZ=APSDUZ

           KILL XMB,APSDUZ,APSERROR,APSBN,APSPAT

 +11       QUIT