- 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
