- PSOPATLK ;BIR/JAM - Patient Lookup utility ;7/21/08
- ;;7.0;OUTPATIENT PHARMACY;**326,348,438,564**;DEC 1997;Build 6
- ;
- ; This API looks for a patient using a prescription number, barcode,
- ; universal Member ID number from the patient's VHIC Card
- ; 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,PAGE
- S DIR(0)="FOU"_$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 - "
- .W !?1,"Enter the universal Member ID number from the patient's VHIC Card"
- .W !?1,"or wand the barcode of the VHIC card"
- .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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPATLK 2317 printed Feb 18, 2025@23:59:04 Page 2
- PSOPATLK ;BIR/JAM - Patient Lookup utility ;7/21/08
- +1 ;;7.0;OUTPATIENT PHARMACY;**326,348,438,564**;DEC 1997;Build 6
- +2 ;
- +3 ; This API looks for a patient using a prescription number, barcode,
- +4 ; universal Member ID number from the patient's VHIC Card
- +5 ; or the registration standard patient lookup.
- +6 ;
- 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,PAGE
- +9 SET DIR(0)="FOU"_$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 - "
- +8 WRITE !?1,"Enter the universal Member ID number from the patient's VHIC Card"
- +9 WRITE !?1,"or wand the barcode of the VHIC card"
- +10 WRITE !?1," - OR - "
- End DoDot:1
- +11 SET DIC="^DPT("
- SET DIC(0)="QZEXN"
- DO ^DIC
- +12 QUIT
- +13 ;
- 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 ;
