APSDALVR.m

APSDALVR ;IHS/DSD/ENM/JCM ; CREATE PCC REFILL 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

 ; IHS/OHPRD/JCM 6/16/89 Changed GVMED+10 by adding a \1

 ;

 S APSRX0=^PSRX(APSRX,0)

 S APSRCT0=^PSRX(APSRX,1,APSRCT,0)

 S %=APSRCT0

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,1,APSRCT)),APCDALVR("APCDADFN") N DR,DA,DIE S DIE="^PSRX(APSRX,1,",DA(1)=APSRX,DA=APSRCT,DR="9999999.11////"_APCDALVR("APCDADFN") D ^DIE K DIE,DA,DR ;IHS/OHPRD/JCM 6/11/90

EXIT K %,APSRCT0

 Q

 ;

GVISIT ;

 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"_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)

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

 S APCDALVR("APCDTDIS")=""

 ;

 S %=APSRCT0

 S APCDALVR("APCDTDAY")=(APCDALVR("APCDTDAY")*($P(%,U,4)/APCDALVR("APCDTQTY")))+.5\1

 S APCDALVR("APCDTQTY")=+$P(%,U,4)\1 ;IHS/OHPRD/JCM 6/16/89

 ;

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

 K APCDALVR("APCDAFLG")

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

 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)="refilled"

 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

APSDALVR  ;IHS/DSD/ENM/JCM ; CREATE PCC REFILL 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       ; IHS/OHPRD/JCM 6/16/89 Changed GVMED+10 by adding a \1

 +5       ;

 +6        SET APSRX0=^PSRX(APSRX,0)

 +7        SET APSRCT0=^PSRX(APSRX,1,APSRCT,0)

 +8        SET %=APSRCT0

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,1,APSRCT))

               IF APCDALVR("APCDADFN")

                   NEW DR,DA,DIE

                   SET DIE="^PSRX(APSRX,1,"

                   SET DA(1)=APSRX

                   SET DA=APSRCT

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

                   DO ^DIE

                   KILL DIE,DA,DR

EXIT       KILL %,APSRCT0

 +1        QUIT 

 +2       ;

GVISIT    ;

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

           SET APCDALVR("APCDANE")=""

 +2        SET AUPNTALK=""

 +3        IF $DATA(^APSPCCTM)

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

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

 +4        DO ^APCDALV

 +5        IF $DATA(APSPCCTM)

               SET ^APSPCCTM(APSPCCTM,2)=$HOROLOG

               KILL APSPCCTM

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

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

               GOTO @("V"_APCDAFLG)

 +8        QUIT 

 +9       ;

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)

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

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

 +7       ;

 +8        SET %=APSRCT0

 +9        SET APCDALVR("APCDTDAY")=(APCDALVR("APCDTDAY")*($PIECE(%,U,4)/APCDALVR("APCDTQTY")))+.5\1

 +10      ;IHS/OHPRD/JCM 6/16/89

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

 +11      ;

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

 +13       KILL APCDALVR("APCDAFLG")

 +14       IF $DATA(^APSPCCTM)

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

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

 +15       DO ^APCDALVR

 +16       IF $DATA(APSPCCTM)

               SET ^APSPCCTM(APSPCCTM,2)=$HOROLOG

               KILL APSPCCTM

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

               GOTO @APCDALVR("APCDAFLG")

 +18       QUIT 

 +19      ;

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)="refilled"

 +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