PSOPATLK ;BIR/JAM - Patient Lookup utility ;7/21/08
;;7.0;OUTPATIENT PHARMACY;**326**;DEC 1997;Build 11
;
; This API looks for a patient using a prescription number, barcode
; or the registration standard patient lookup.
;
EN ;Entry point - Prompts for Patient, Prescription Number or Barcode
;
; Input - DIC(0) & DIC("A") [Optional]
; Used by DIR if defined by the calling routine.
;
; Output - PSOPTLK [Processed user response]
;
N DIR
K PSOPTLK
S DIR(0)="FO"_$S($D(DIC("A")):"A",1:"")_"^^K:$$PATVAL^PSOPATLK() X"
S DIR("A")=$S($D(DIC("A")):DIC("A"),1:"Select PATIENT NAME")
S (DIR("?"),DIR("??"))="^D PATHLP^PSOPATLK"
D ^DIR
M PSOPTLK=Y
K DIROUT,DIRUT,DTOUT,DUOUT
Q
PATHLP ;Help text for patient prompt
N DIC
I $E(X)'="?" Q
I X="?" D
.W !?1,"Enter the prescription number prefixed by a # (ex. #XXXXXXX) or"
.W !?1,"Wand the barcode of the prescription. The format of the barcode is"
.W !?1,"NNN-NNNNNNN where the first 3 digits are your station number."
.W !?1," - OR - "
S DIC="^DPT(",DIC(0)="QZEXN" D ^DIC
Q
;
PATVAL() ;Validate user input
N OUT
S OUT=0
;Prescription lookup
I X?1"#".E D RXLK Q OUT
;Barcode lookup
I X?3N1"-".N D RXLK Q OUT
;Standard patient lookup
S DIC="^DPT(" S:'$D(DIC(0)) DIC(0)="QEMZ" D ^DIC
S OUT=$S(+Y>0:0,1:1)
Q OUT
;
RXLK ;Prescription Lookup
N DFN,DIC,RXNUM,RX,Z
S RXNUM=X,RX=$S($E(RXNUM)="#":$E(RXNUM,2,999999999),1:$P(RXNUM,"-",2))
I RX="" W !,$C(7),"No prescription number entered." S OUT=1 Q
I $E(RXNUM)'="#",$P(RXNUM,"-")'=$$INST() D S OUT=1 Q
.W !!,$C(7),"This prescription is not from this institution."
S Z=$S($E(RXNUM)="#":$O(^PSRX("B",RX,0)),1:RX),Y=$G(^PSRX(+Z,0))
I (Y="")!(Z="") D S OUT=1 Q
.W !,$C(7),"No Prescription Record found"_$S($E(RXNUM)="#":".",1:" for this barcode.")
S DFN=$P(Y,"^",2) K Y
N DIC,X S DIC="^DPT(",DIC(0)="QZEXN" S X=DFN D ^DIC
Q
INST() ;get institution number
N PSOINST,DA,DIQ
S DA=$P($$SITE^VASITE(),"^")
S PSOINST=$$GET1^DIQ(4,DA,99,"I")
Q PSOINST
;
PSOPATLK ;BIR/JAM - Patient Lookup utility ;7/21/08
+1 ;;7.0;OUTPATIENT PHARMACY;**326**;DEC 1997;Build 11
+2 ;
+3 ; This API looks for a patient using a prescription number, barcode
+4 ; or the registration standard patient lookup.
+5 ;
EN ;Entry point - Prompts for Patient, Prescription Number or Barcode
+1 ;
+2 ; Input - DIC(0) & DIC("A") [Optional]
+3 ; Used by DIR if defined by the calling routine.
+4 ;
+5 ; Output - PSOPTLK [Processed user response]
+6 ;
+7 NEW DIR
+8 KILL PSOPTLK
+9 SET DIR(0)="FO"_$SELECT($DATA(DIC("A")):"A",1:"")_"^^K:$$PATVAL^PSOPATLK() X"
+10 SET DIR("A")=$SELECT($DATA(DIC("A")):DIC("A"),1:"Select PATIENT NAME")
+11 SET (DIR("?"),DIR("??"))="^D PATHLP^PSOPATLK"
+12 DO ^DIR
+13 MERGE PSOPTLK=Y
+14 KILL DIROUT,DIRUT,DTOUT,DUOUT
+15 QUIT
PATHLP ;Help text for patient prompt
+1 NEW DIC
+2 IF $EXTRACT(X)'="?"
QUIT
+3 IF X="?"
Begin DoDot:1
+4 WRITE !?1,"Enter the prescription number prefixed by a # (ex. #XXXXXXX) or"
+5 WRITE !?1,"Wand the barcode of the prescription. The format of the barcode is"
+6 WRITE !?1,"NNN-NNNNNNN where the first 3 digits are your station number."
+7 WRITE !?1," - OR - "
End DoDot:1
+8 SET DIC="^DPT("
SET DIC(0)="QZEXN"
DO ^DIC
+9 QUIT
+10 ;
PATVAL() ;Validate user input
+1 NEW OUT
+2 SET OUT=0
+3 ;Prescription lookup
+4 IF X?1"#".E
DO RXLK
QUIT OUT
+5 ;Barcode lookup
+6 IF X?3N1"-".N
DO RXLK
QUIT OUT
+7 ;Standard patient lookup
+8 SET DIC="^DPT("
IF '$DATA(DIC(0))
SET DIC(0)="QEMZ"
DO ^DIC
+9 SET OUT=$SELECT(+Y>0:0,1:1)
+10 QUIT OUT
+11 ;
RXLK ;Prescription Lookup
+1 NEW DFN,DIC,RXNUM,RX,Z
+2 SET RXNUM=X
SET RX=$SELECT($EXTRACT(RXNUM)="#":$EXTRACT(RXNUM,2,999999999),1:$PIECE(RXNUM,"-",2))
+3 IF RX=""
WRITE !,$CHAR(7),"No prescription number entered."
SET OUT=1
QUIT
+4 IF $EXTRACT(RXNUM)'="#"
IF $PIECE(RXNUM,"-")'=$$INST()
Begin DoDot:1
+5 WRITE !!,$CHAR(7),"This prescription is not from this institution."
End DoDot:1
SET OUT=1
QUIT
+6 SET Z=$SELECT($EXTRACT(RXNUM)="#":$ORDER(^PSRX("B",RX,0)),1:RX)
SET Y=$GET(^PSRX(+Z,0))
+7 IF (Y="")!(Z="")
Begin DoDot:1
+8 WRITE !,$CHAR(7),"No Prescription Record found"_$SELECT($EXTRACT(RXNUM)="#":".",1:" for this barcode.")
End DoDot:1
SET OUT=1
QUIT
+9 SET DFN=$PIECE(Y,"^",2)
KILL Y
+10 NEW DIC,X
SET DIC="^DPT("
SET DIC(0)="QZEXN"
SET X=DFN
DO ^DIC
+11 QUIT
INST() ;get institution number
+1 NEW PSOINST,DA,DIQ
+2 SET DA=$PIECE($$SITE^VASITE(),"^")
+3 SET PSOINST=$$GET1^DIQ(4,DA,99,"I")
+4 QUIT PSOINST
+5 ;
