PSOPRA ;BIR/JLC/MHA - INTERNET PRESCRIPTION REFILL APIS ; 4/14/05 4:51pm
;;7.0;OUTPATIENT PHARMACY;**116,151,204,264**;DEC 1997;Build 19
;
Q
AP1(PSODFN,PSORX) ;ACCEPT REQUEST
; Input: PSODFN (required) - Patient IEN Number
; PSORX (required) - Prescription Number
; Output: PSORET - Return Value
; See IA# 3768 for description and values
;
N PSORET,PSRX,PSRXD,IEN,PSORR,PSOICN,SITE,PSOSITE
I $G(PSODFN)="" S PSORET=-4 G QUITAP1
S PSOICN=+$$GETICN^MPIF001(PSODFN)
I +$G(PSOICN)=-1 S PSORET=-4 G QUITAP1
I $G(PSORX)="" S PSORET=-3 G QUITAP1
I $O(^PSRX("B",PSORX,""))="" S PSORET=-3 G QUITAP1
I '$D(^PSRX("B",PSORX)) S PSORET=-3 G QUITAP1
S PSRX=$O(^PSRX("B",PSORX,"")),PSRXD=$G(^PSRX(PSRX,0))
I PSRXD="" S PSORET=-3 G QUITAP1
I $P(PSRXD,"^",2)'=PSODFN S PSORET=-5 G QUITAP1
S (SITE,DA)=$P(^XMB(1,1,"XUS"),"^",17),DIC="4",DIQ(0)="IE",DR=".01;99",DIQ="PSXUTIL" D EN^DIQ1 S PSOSITE=$G(PSXUTIL(4,SITE,99,"I"))
I '$D(^PS(52.43,"AC",PSODFN,PSORX)) G FILEAP1
S IEN=$O(^PS(52.43,"AC",PSODFN,PSORX,""))
I '$D(^PS(52.43,IEN,0)) G FILEAP1
S PSORR=$G(^PS(52.43,IEN,0))
I $P(PSORR,"^",5)="" S PSORET=-2 G QUITAP1
S PSORET=-1 G QUITAP1
FILEAP1 K DO,DIC,DD S DIC(0)="L",DIC=52.43,X=PSOICN D FILE^DICN I Y=-1 S PSORET=0 G QUITAP1
N % D NOW^%DTC
K DA,DR,DIE S DA=+Y,DIE=DIC,DR="3///"_PSORX_";7///0;8///"_PSRX_";4///"_PSOSITE_";9////"_PSODFN_";11///"_$E(%,1,12) D ^DIE
S PSORET=1
QUITAP1 Q PSORET
;
AP2(PSODFN,PSORX) ;STATUS OF REQUEST
; Input: PSODFN (required) - Patient IEN Number
; PSORX (required) - Prescription Number
; Output: PSORET - Return Value
; See IA ... for description and values
;
N PSORET,PSORR,IEN
I $G(PSODFN)="" S PSORET=-4 G QUITAP2
I $G(PSORX)="" S PSORET=-3 G QUITAP2
I '$D(^PS(52.43,"AC",PSODFN,PSORX)) S PSORET=-6 G QUITAP2
S IEN=$O(^PS(52.43,"AC",PSODFN,PSORX,""))
I '$D(^PS(52.43,IEN,0)) K ^PS(52.43,"AC",PSODFN,PSORX) S PSORET=-6 G QUITAP2
S PSORR=$G(^PS(52.43,IEN,0))
I $P(PSORR,"^",5)="" S PSORET=-2 G QUITAP2
S PSORET=$P(PSORR,"^",6)_"^"_$P(PSORR,"^",5)
QUITAP2 Q PSORET
;
AP5(PSODFN,PSORX) ;PROCESS MHEV UPDATE
; Input: PSODFN (required) - Patient IEN Number
; PSORX (required) - Prescription Number
; Output: PSORET - Return Value
; See IA ... for description and values
;
N PSORET,PSORR,IEN,PSOIN
I $G(PSODFN)="" S PSORET=-4 G ENDAP5
I $G(PSORX)="" S PSORET=-3 G ENDAP5
I '$D(^PS(52.43,"AC",PSODFN,PSORX)) S PSORET=-6 G ENDAP5
S IEN=$O(^PS(52.43,"AC",PSODFN,PSORX,""))
I '$D(^PS(52.43,IEN,0)) K ^PS(52.43,"AC",PSODFN,PSORX) S PSORET=-6 G ENDAP5
S PSORR=$G(^PS(52.43,IEN,0))
I $P(PSORR,"^",5)="" S PSORET=-2 G ENDAP5
S PSOIN=$P(PSORR,"^",4)
K DA,DR,DIE
S DA=IEN
S DIE="^PS(52.43,",DR="7///1" D ^DIE S PSORET=1
K ^PS(52.43,"AC",PSODFN,PSORX)
ENDAP5 Q PSORET
;
AP6(PSODIEN,PSOAP6) ;OUTPATIENT PHARMACY DIVISION LOOKUP
; Input: PSODIEN (required) - Outpatient Pharmacy Division IEN.
; 1. Single Division IEN.
; 2. Delimited list of Division IEN's (IEN1,IEN2,IEN3).
; 3. Text word "ALL".
; PSOAP6 (required) - Information return Array.
; Output: PSOAP6 - Information return Array.
; PSOAP6(DIV)=Active(0)/Inactive(1)
; PSOAP6(DIV,1)=Division Name^Area Code^Phone Number
; PSOAP6(DIV,2,1)=Narrative text 1st line.
; PSOAP6(DIV,2,n)=Narrative text nth line.
; PSORET - 0 (Process failure).
; 1 (Process success).
;
N DIEN,TEMP,NAME,AREACODE,PHONENUM,INACTIVE
Q:$G(PSODIEN)="" 0
I PSODIEN="ALL" S ZS2=$O(^PS(59,0)),PSODIEN=ZS2 Q:'+ZS2 0 F S ZS2=$O(^PS(59,ZS2)) Q:'+ZS2 S PSODIEN=PSODIEN_","_ZS2
F XX=1:1:$L(PSODIEN,",") S DIEN=$P(PSODIEN,",",XX) D
.S NAME=$$GET1^DIQ(59,DIEN,".01")
.Q:NAME=""
.S AREACODE=$$GET1^DIQ(59,DIEN,".03")
.S PHONENUM=$$GET1^DIQ(59,DIEN,".04")
.S INACTIVE=$$GET1^DIQ(59,DIEN,2004,"I")
.S PSOAP6(DIEN)=0 I INACTIVE S PSOAP6(DIEN)=1
.S PSOAP6(DIEN,1)=NAME_"^"_AREACODE_"^"_PHONENUM
.S TEMP=$$GET1^DIQ(59,DIEN,1005,"","PSOAP6("_DIEN_",2)")
;
ENDAP6 Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPRA 4183 printed Dec 13, 2024@02:33 Page 2
PSOPRA ;BIR/JLC/MHA - INTERNET PRESCRIPTION REFILL APIS ; 4/14/05 4:51pm
+1 ;;7.0;OUTPATIENT PHARMACY;**116,151,204,264**;DEC 1997;Build 19
+2 ;
+3 QUIT
AP1(PSODFN,PSORX) ;ACCEPT REQUEST
+1 ; Input: PSODFN (required) - Patient IEN Number
+2 ; PSORX (required) - Prescription Number
+3 ; Output: PSORET - Return Value
+4 ; See IA# 3768 for description and values
+5 ;
+6 NEW PSORET,PSRX,PSRXD,IEN,PSORR,PSOICN,SITE,PSOSITE
+7 IF $GET(PSODFN)=""
SET PSORET=-4
GOTO QUITAP1
+8 SET PSOICN=+$$GETICN^MPIF001(PSODFN)
+9 IF +$GET(PSOICN)=-1
SET PSORET=-4
GOTO QUITAP1
+10 IF $GET(PSORX)=""
SET PSORET=-3
GOTO QUITAP1
+11 IF $ORDER(^PSRX("B",PSORX,""))=""
SET PSORET=-3
GOTO QUITAP1
+12 IF '$DATA(^PSRX("B",PSORX))
SET PSORET=-3
GOTO QUITAP1
+13 SET PSRX=$ORDER(^PSRX("B",PSORX,""))
SET PSRXD=$GET(^PSRX(PSRX,0))
+14 IF PSRXD=""
SET PSORET=-3
GOTO QUITAP1
+15 IF $PIECE(PSRXD,"^",2)'=PSODFN
SET PSORET=-5
GOTO QUITAP1
+16 SET (SITE,DA)=$PIECE(^XMB(1,1,"XUS"),"^",17)
SET DIC="4"
SET DIQ(0)="IE"
SET DR=".01;99"
SET DIQ="PSXUTIL"
DO EN^DIQ1
SET PSOSITE=$GET(PSXUTIL(4,SITE,99,"I"))
+17 IF '$DATA(^PS(52.43,"AC",PSODFN,PSORX))
GOTO FILEAP1
+18 SET IEN=$ORDER(^PS(52.43,"AC",PSODFN,PSORX,""))
+19 IF '$DATA(^PS(52.43,IEN,0))
GOTO FILEAP1
+20 SET PSORR=$GET(^PS(52.43,IEN,0))
+21 IF $PIECE(PSORR,"^",5)=""
SET PSORET=-2
GOTO QUITAP1
+22 SET PSORET=-1
GOTO QUITAP1
FILEAP1 KILL DO,DIC,DD
SET DIC(0)="L"
SET DIC=52.43
SET X=PSOICN
DO FILE^DICN
IF Y=-1
SET PSORET=0
GOTO QUITAP1
+1 NEW %
DO NOW^%DTC
+2 KILL DA,DR,DIE
SET DA=+Y
SET DIE=DIC
SET DR="3///"_PSORX_";7///0;8///"_PSRX_";4///"_PSOSITE_";9////"_PSODFN_";11///"_$EXTRACT(%,1,12)
DO ^DIE
+3 SET PSORET=1
QUITAP1 QUIT PSORET
+1 ;
AP2(PSODFN,PSORX) ;STATUS OF REQUEST
+1 ; Input: PSODFN (required) - Patient IEN Number
+2 ; PSORX (required) - Prescription Number
+3 ; Output: PSORET - Return Value
+4 ; See IA ... for description and values
+5 ;
+6 NEW PSORET,PSORR,IEN
+7 IF $GET(PSODFN)=""
SET PSORET=-4
GOTO QUITAP2
+8 IF $GET(PSORX)=""
SET PSORET=-3
GOTO QUITAP2
+9 IF '$DATA(^PS(52.43,"AC",PSODFN,PSORX))
SET PSORET=-6
GOTO QUITAP2
+10 SET IEN=$ORDER(^PS(52.43,"AC",PSODFN,PSORX,""))
+11 IF '$DATA(^PS(52.43,IEN,0))
KILL ^PS(52.43,"AC",PSODFN,PSORX)
SET PSORET=-6
GOTO QUITAP2
+12 SET PSORR=$GET(^PS(52.43,IEN,0))
+13 IF $PIECE(PSORR,"^",5)=""
SET PSORET=-2
GOTO QUITAP2
+14 SET PSORET=$PIECE(PSORR,"^",6)_"^"_$PIECE(PSORR,"^",5)
QUITAP2 QUIT PSORET
+1 ;
AP5(PSODFN,PSORX) ;PROCESS MHEV UPDATE
+1 ; Input: PSODFN (required) - Patient IEN Number
+2 ; PSORX (required) - Prescription Number
+3 ; Output: PSORET - Return Value
+4 ; See IA ... for description and values
+5 ;
+6 NEW PSORET,PSORR,IEN,PSOIN
+7 IF $GET(PSODFN)=""
SET PSORET=-4
GOTO ENDAP5
+8 IF $GET(PSORX)=""
SET PSORET=-3
GOTO ENDAP5
+9 IF '$DATA(^PS(52.43,"AC",PSODFN,PSORX))
SET PSORET=-6
GOTO ENDAP5
+10 SET IEN=$ORDER(^PS(52.43,"AC",PSODFN,PSORX,""))
+11 IF '$DATA(^PS(52.43,IEN,0))
KILL ^PS(52.43,"AC",PSODFN,PSORX)
SET PSORET=-6
GOTO ENDAP5
+12 SET PSORR=$GET(^PS(52.43,IEN,0))
+13 IF $PIECE(PSORR,"^",5)=""
SET PSORET=-2
GOTO ENDAP5
+14 SET PSOIN=$PIECE(PSORR,"^",4)
+15 KILL DA,DR,DIE
+16 SET DA=IEN
+17 SET DIE="^PS(52.43,"
SET DR="7///1"
DO ^DIE
SET PSORET=1
+18 KILL ^PS(52.43,"AC",PSODFN,PSORX)
ENDAP5 QUIT PSORET
+1 ;
AP6(PSODIEN,PSOAP6) ;OUTPATIENT PHARMACY DIVISION LOOKUP
+1 ; Input: PSODIEN (required) - Outpatient Pharmacy Division IEN.
+2 ; 1. Single Division IEN.
+3 ; 2. Delimited list of Division IEN's (IEN1,IEN2,IEN3).
+4 ; 3. Text word "ALL".
+5 ; PSOAP6 (required) - Information return Array.
+6 ; Output: PSOAP6 - Information return Array.
+7 ; PSOAP6(DIV)=Active(0)/Inactive(1)
+8 ; PSOAP6(DIV,1)=Division Name^Area Code^Phone Number
+9 ; PSOAP6(DIV,2,1)=Narrative text 1st line.
+10 ; PSOAP6(DIV,2,n)=Narrative text nth line.
+11 ; PSORET - 0 (Process failure).
+12 ; 1 (Process success).
+13 ;
+14 NEW DIEN,TEMP,NAME,AREACODE,PHONENUM,INACTIVE
+15 if $GET(PSODIEN)=""
QUIT 0
+16 IF PSODIEN="ALL"
SET ZS2=$ORDER(^PS(59,0))
SET PSODIEN=ZS2
if '+ZS2
QUIT 0
FOR
SET ZS2=$ORDER(^PS(59,ZS2))
if '+ZS2
QUIT
SET PSODIEN=PSODIEN_","_ZS2
+17 FOR XX=1:1:$LENGTH(PSODIEN,",")
SET DIEN=$PIECE(PSODIEN,",",XX)
Begin DoDot:1
+18 SET NAME=$$GET1^DIQ(59,DIEN,".01")
+19 if NAME=""
QUIT
+20 SET AREACODE=$$GET1^DIQ(59,DIEN,".03")
+21 SET PHONENUM=$$GET1^DIQ(59,DIEN,".04")
+22 SET INACTIVE=$$GET1^DIQ(59,DIEN,2004,"I")
+23 SET PSOAP6(DIEN)=0
IF INACTIVE
SET PSOAP6(DIEN)=1
+24 SET PSOAP6(DIEN,1)=NAME_"^"_AREACODE_"^"_PHONENUM
+25 SET TEMP=$$GET1^DIQ(59,DIEN,1005,"","PSOAP6("_DIEN_",2)")
End DoDot:1
+26 ;
ENDAP6 QUIT 1
