ABSPOSIF ; IHS/FCS/DRS - handle FIND command ; [ 09/12/2002 10:11 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,46**;JUN 21, 2001;Build 38
; "FIND" - when typed at Prescription field, here's what happens
Q
TEST N RETVAL S RETVAL=$$RXFIND()
W ! D ZWRITE^ABSPOS("RETVAL")
Q
RXFIND(PAT,TYPE,VISITIN) ;EP - from ABSPOSI1
;lookup prescription - return RXI^RXR
; If you don't send the patient or the visitIEN, a lookup is done.
; TYPE = 1 looking for a prescription - return RXI^RXR
; TYPE = 2 looking for a visit - return VISITIEN
; TYPE = 3 (default) don't know which; ask.
; Which one is returned? $L(returned value,U)=1 or 2 tells you
; Returns False if no selection made.
;
; We lookup the patient first, then the visit, and
; then the prescription based on the visit
;
N PATNAME,SEL,VISITIEN,TTYPE
N DDS ; they have ScreenMan hooks in ^DIR - they are poison to this
; ABSPOSIF program! NEW safely disables them for now.
; all NEWs above this line ^^^ because there are GOTOs below
RXFINDA I $D(VISITIN) S VISITIEN=VISITIN,PAT=$P(^AUPNVSIT(VISITIEN,0),U,5)
E S VISITIEN=0
I '$G(PAT) S PAT=$$PATFIND I 'PAT G RXFINDX
I '$D(TYPE) S TYPE=3
S PATNAME=$P(^DPT(PAT,0),U)
;
I 'VISITIEN D
. W !,"...Searching for visits and prescriptions for "_PATNAME_" ...",!
RXFINDC S SEL=$$VISIFIND(PAT,TYPE,VISITIEN) I 'SEL K PAT G RXFINDA
; Side effect - we still have ^TMP($J,"LIST",SEL,"X")=count of prescs
S VISITIEN=^TMP($J,"LIST",SEL,"I")
;
; Are you looking for a visit or for a prescription?
I TYPE=1 G RXFINDK
I TYPE=2 Q VISITIEN ; looking for a visit - you've got it - done
; But if there are no prescriptions with this visit, and they saw
; the list, then just take the visit and don't ask.
I '$G(VISITIN),'^TMP($J,"LIST",SEL,"X") Q VISITIEN
S TTYPE=$$TTYPE
I 'TTYPE K PAT G RXFINDA
I TTYPE=1 G RXFINDK
I TTYPE=2 Q VISITIEN
D IMPOSS^ABSPOSUE("P","TI","Bad TTYPE="_TTYPE,,"RXFINDC",$T(+0))
;
RXFINDK ; If there was only one prescription with the visit, that's the one
; we take - the drug name and date was shown, we know that's the one
;
I ^TMP($J,"LIST",SEL,"X")=1 D Q X
. N RXI S RXI=$O(^TMP($J,"LIST",SEL,"X",""))
. N RXR S RXR=$O(^TMP($J,"LIST",SEL,"X",RXI,""))
. S X=RXI_U_RXR
;
I ^TMP($J,"LIST",SEL,"X")=0 D G RXFINDC
. W !,"This visit has no prescriptions! Try again..." H 2 W !
;
S SEL=$$WHICHRX(SEL) I 'SEL G RXFINDC
Q ^TMP($J,"LIST",SEL,"I") ; RXI^RXR
RXFINDX ; removed call ; ABSP*1.0T7*8 ; D REFRESH^DDSUTL
Q -1
TTYPE() ; so what are you looking for?
N PROMPT,DEFAULT,OPT,DISPLAY,CHOICES,TIMEOUT,ANS
S PROMPT="What kind of charge is this for? "
S DEFAULT="P",OPT=1,DISPLAY="V"
S CHOICES="P:Prescription;N:Non-prescription item"
S TIMEOUT=$S($G(DTOUT):DTOUT,1:300)
S ANS=$$SET^ABSPOSU3(PROMPT,DEFAULT,OPT,DISPLAY,CHOICES,TIMEOUT)
Q $S(ANS="P":1,ANS="N":2,1:"")
WHICHRX(SEL) ; given ^TMP($J,"LIST" and SEL from visit selection,
; present another list to select which prescription
N TMP M TMP=^TMP($J,"LIST",SEL,"X") ; TMP=count, TMP(RXI,RXR)=""
N VISIDESC S VISIDESC=^TMP($J,"LIST",SEL,"E")
K ^TMP($J,"LIST") S ^TMP($J,"LIST",0)=0
N TYPE S TYPE="S"
N LISTROOT S LISTROOT="^TMP("_$J_",""LIST"","
N X S X="1|Prescrip.:10,Drug:30,Fill Date:11,Quantity:10"
S ^TMP($J,"LIST","Column Headers")=X
N TITLE S TITLE="Select a prescription for "_PATNAME_" from this visit"
N PROMPT S PROMPT(1)=VISIDESC
N OPT S OPT=1
N ANSROOT S ANSROOT="^TMP($J,""ANS""," K ^TMP($J,"ANS")
N RXI,RXR S RXI=0 F S RXI=$O(TMP(RXI)) Q:'RXI D
. S RXR="" F S RXR=$O(TMP(RXI,RXR)) Q:RXR="" D
. . N N S (N,^TMP($J,"LIST",0))=^TMP($J,"LIST",0)+1
. . N Z S Z=$G(^PSRX(RXI,0))
. . N DRUGIEN S DRUGIEN=$P(Z,U,6)
. . N DRUGNAME I DRUGIEN S DRUGNAME=$P($G(^PSDRUG(DRUGIEN,0)),U)
. . E S DRUGIEN="?"
. . N DATE,QTY
. . I RXR D
. . . N Z S Z=$G(^PSRX(RXI,1,RXR,0))
. . . S DATE=$P(Z,U)
. . . S QTY=$P(Z,U,4)
. . E D
. . . S DATE=$P($G(^PSRX(RXI,2)),U,2)
. . . S QTY=$P(Z,U,7)
. . N Y S Y=DATE X ^DD("DD") S DATE=Y
. . S QTY=$$FMTQTY(QTY)
. . N X S X=$$LJBF("`"_RXI,10)_" "_$$LJBF(DRUGNAME,30)
. . S X=X_" "_$$LJBF(DATE,11)_" "_$$LJBF($$FMTQTY(QTY),10)
. . S ^TMP($J,"LIST",N,"E")=X
. . S ^TMP($J,"LIST",N,"I")=RXI_U_RXR
S X=$$LIST^ABSPOSU4(TYPE,LISTROOT,ANSROOT,TITLE,.PROMPT,OPT)
I "^^"[X Q ""
I X<0 Q ""
;IHS/OIT/RCS 7/8/2013 Patch 46 - Only allow one number from list to be selected
I X'?1N.N Q ""
Q X
FMTQTY(QTY) ; decimal, 3 places, but no excess trailing zeroes
I QTY#1=0 Q QTY_" "
S QTY=$J(QTY,0,3)
I QTY?.E1"."1N1"00" S $E(QTY,$L(QTY)-1,$L(QTY))=" "
E I QTY?.E1"."2N1"0" S $E(QTY,$L(QTY))=" "
Q QTY
VISIFIND(PAT,RXTYPE,VISITIEN) ; given patient IEN, present a list of visits
; if RXTYPE=1, then pick only visits which have prescriptions
; returns index of one selected, and ^TMP($J,"LIST",***) left over
; returns false if none selected
; VISITIEN'=0 means "this is the visit I want, fake it out as if it
; had been selected from the list."
;W "In VISIFIND with " ZW PAT,RXTYPE H 1
I $G(PAT) S PATNAME=$P(^DPT(PAT,0),U)
N TYPE S TYPE="S" ; single item selection
N LISTROOT S LISTROOT="^TMP("_$J_",""LIST""," K ^TMP($J,"LIST")
N X S X="1|Visit:12,Date:14,Clinic:15,Prescriptions:25"
S ^TMP($J,"LIST","Column Headers")=X
N ANSROOT S ANSROOT="^TMP("_$J_",""ANS""," K ^TMP($J,"ANS")
D VISLIST(VISITIEN)
N TITLE S TITLE="Select a visit"
I $G(PAT) S TITLE=TITLE_" for "_PATNAME
N PROMPT S PROMPT="Item number (^ to exit)"
N OPT S OPT=1
N X
I VISITIEN S X=1 ; we specified it, we pretend we selected it
E I '^TMP($J,"LIST",0) D S X=""
. W PATNAME," has no visits on file.",!
E S X=$$LIST^ABSPOSU4(TYPE,LISTROOT,ANSROOT,TITLE,PROMPT,OPT)
I "^^"[X Q ""
I X<0 Q ""
;IHS/OIT/RCS 7/8/2013 Patch 46 - Only allow one number from list to be selected
I X'?1N.N Q ""
Q X
VISLIST(VISITIEN) ; set up LISTROOT ; given PAT ; if $$, it returns the count
; variations? haven't thought it through - for now, must have PAT
N ROOT S ROOT=$E(LISTROOT,1,$L(LISTROOT)-1)_")"
S @ROOT@(0)=0
N TIME9 S TIME9=""
F S TIME9=$O(^AUPNVSIT("AA",PAT,TIME9)) Q:'TIME9 D ; in reverse
. N VSTIEN S VSTIEN=0
. F S VSTIEN=$O(^AUPNVSIT("AA",PAT,TIME9,VSTIEN)) Q:VSTIEN="" D
. . I $G(VISITIEN) Q:VISITIEN'=VSTIEN ; when we want only this one
. . N VCN,DATE,CLINIC,DELETED,PRESC,RXI,RXR,Z,Y,X,N,RXINFO
. . S VCN=$P($G(^AUPNVSIT(VSTIEN,"VCN")),U)
. . I VCN="" S VCN="`"_VSTIEN
. . S Z=^AUPNVSIT(VSTIEN,0)
. . I $P(Z,U,11) S VCN="D!"_VCN ; deleted visit!
. . S Y=$P(Z,U) X ^DD("DD") S DATE=$P(Y,"@")_"@"_$P($P(Y,"@",2),":")
. . S CLINIC=$P(Z,U,8) I CLINIC S CLINIC=$P($G(^DIC(40.7,CLINIC,0)),U)
. . ;
. . S N=@ROOT@(0)+1 ; don't store in @ROOT@(0) until you keep it
. . ;
. . D VISRX(VSTIEN,$E(ROOT,1,$L(ROOT)-1)_","_N_",""X"")")
. . ;
. . I @ROOT@(N,"X")=1 D ; exactly one prescription - print drug name
. . . S RXI=$O(@ROOT@(N,"X",""))
. . . S RXINFO=$P($G(^PSRX(RXI,0)),U,6)
. . . I RXINFO S RXINFO=$P($G(^PSDRUG(RXINFO,0)),U)
. . . I RXINFO="" S RXINFO="missing data"
. . E I @ROOT@(N,"X") D ; more than 1 prescriptions
. . . S RXINFO=@ROOT@(N,"X")_" prescriptions"
. . E D ; 0 prescriptions
. . . S RXINFO="none"
. . I RXINFO="none",RXTYPE=1 Q ; stop, we only want prescriptions
. . S X=$$LJBF(VCN,12)
. . S X=X_" "_$$LJBF(DATE,15)
. . S X=X_" "_$$LJBF(CLINIC,15)
. . S X=X_" "_$$LJBF(RXINFO,25)
. . S @ROOT@(N,"E")=X
. . S @ROOT@(N,"I")=VSTIEN
. . S @ROOT@(0)=N
Q:$Q @ROOT@(0) Q
VISRX(VISIT,ROOT) ; build @ROOT=count of prescriptions for this visit
; @ROOT@(RXI,RXR)="" for each prescription
; Jump there via V MEDICATION
I '$D(@ROOT) S @ROOT=0
N VMED S VMED=0
F S VMED=$O(^AUPNVMED("AD",VISIT,VMED)) Q:VMED="" D VMEDRX(VMED,ROOT)
Q
VMEDRX(VMEDIEN,ROOT) ; called from VISRX
N RXI,RXR
S RXI=0 F S RXI=$O(^PSRX("APCC",VMEDIEN,RXI)) Q:'RXI D
. I $D(^(RXI))=1 S @ROOT@(RXI,0)="",@ROOT=@ROOT+1
. E S RXR=0 F S RXR=$O(^PSRX("APCC",VMEDIEN,RXI,RXR)) Q:'RXR D
. . S @ROOT@(RXI,RXR)=""
. . S @ROOT=@ROOT+1
Q
PATFIND() ; return patient IEN, or false if none selected
N DIC,Y,DUOUT,DTOUT,X,DLAYGO,DINUM,RETVAL
S DIC=2,DIC(0)="AEMNQZ"
;
; Removed this screen. If memory serves, this "C" index is not
; reliable. Besides, we need flexibility to find patients and visits
; which don't have prescription file entries, since we'll be entering
; non-prescription items, too.
; ,DIC("S")="I $D(^PSRX(""C"",Y))"
;
D ^DIC ; lookup patient
Q $S(Y<0:"",1:+Y)
LJBF(X,N) Q $E(X_$J("",N-$L(X)),1,N)
ABSPOSIF ; IHS/FCS/DRS - handle FIND command ; [ 09/12/2002 10:11 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,46**;JUN 21, 2001;Build 38
+2 ; "FIND" - when typed at Prescription field, here's what happens
+3 QUIT
TEST NEW RETVAL
SET RETVAL=$$RXFIND()
+1 WRITE !
DO ZWRITE^ABSPOS("RETVAL")
+2 QUIT
RXFIND(PAT,TYPE,VISITIN) ;EP - from ABSPOSI1
+1 ;lookup prescription - return RXI^RXR
+2 ; If you don't send the patient or the visitIEN, a lookup is done.
+3 ; TYPE = 1 looking for a prescription - return RXI^RXR
+4 ; TYPE = 2 looking for a visit - return VISITIEN
+5 ; TYPE = 3 (default) don't know which; ask.
+6 ; Which one is returned? $L(returned value,U)=1 or 2 tells you
+7 ; Returns False if no selection made.
+8 ;
+9 ; We lookup the patient first, then the visit, and
+10 ; then the prescription based on the visit
+11 ;
+12 NEW PATNAME,SEL,VISITIEN,TTYPE
+13 ; they have ScreenMan hooks in ^DIR - they are poison to this
NEW DDS
+14 ; ABSPOSIF program! NEW safely disables them for now.
+15 ; all NEWs above this line ^^^ because there are GOTOs below
RXFINDA IF $DATA(VISITIN)
SET VISITIEN=VISITIN
SET PAT=$PIECE(^AUPNVSIT(VISITIEN,0),U,5)
+1 IF '$TEST
SET VISITIEN=0
+2 IF '$GET(PAT)
SET PAT=$$PATFIND
IF 'PAT
GOTO RXFINDX
+3 IF '$DATA(TYPE)
SET TYPE=3
+4 SET PATNAME=$PIECE(^DPT(PAT,0),U)
+5 ;
+6 IF 'VISITIEN
Begin DoDot:1
+7 WRITE !,"...Searching for visits and prescriptions for "_PATNAME_" ...",!
End DoDot:1
RXFINDC SET SEL=$$VISIFIND(PAT,TYPE,VISITIEN)
IF 'SEL
KILL PAT
GOTO RXFINDA
+1 ; Side effect - we still have ^TMP($J,"LIST",SEL,"X")=count of prescs
+2 SET VISITIEN=^TMP($JOB,"LIST",SEL,"I")
+3 ;
+4 ; Are you looking for a visit or for a prescription?
+5 IF TYPE=1
GOTO RXFINDK
+6 ; looking for a visit - you've got it - done
IF TYPE=2
QUIT VISITIEN
+7 ; But if there are no prescriptions with this visit, and they saw
+8 ; the list, then just take the visit and don't ask.
+9 IF '$GET(VISITIN)
IF '^TMP($JOB,"LIST",SEL,"X")
QUIT VISITIEN
+10 SET TTYPE=$$TTYPE
+11 IF 'TTYPE
KILL PAT
GOTO RXFINDA
+12 IF TTYPE=1
GOTO RXFINDK
+13 IF TTYPE=2
QUIT VISITIEN
+14 DO IMPOSS^ABSPOSUE("P","TI","Bad TTYPE="_TTYPE,,"RXFINDC",$TEXT(+0))
+15 ;
RXFINDK ; If there was only one prescription with the visit, that's the one
+1 ; we take - the drug name and date was shown, we know that's the one
+2 ;
+3 IF ^TMP($JOB,"LIST",SEL,"X")=1
Begin DoDot:1
+4 NEW RXI
SET RXI=$ORDER(^TMP($JOB,"LIST",SEL,"X",""))
+5 NEW RXR
SET RXR=$ORDER(^TMP($JOB,"LIST",SEL,"X",RXI,""))
+6 SET X=RXI_U_RXR
End DoDot:1
QUIT X
+7 ;
+8 IF ^TMP($JOB,"LIST",SEL,"X")=0
Begin DoDot:1
+9 WRITE !,"This visit has no prescriptions! Try again..."
HANG 2
WRITE !
End DoDot:1
GOTO RXFINDC
+10 ;
+11 SET SEL=$$WHICHRX(SEL)
IF 'SEL
GOTO RXFINDC
+12 ; RXI^RXR
QUIT ^TMP($JOB,"LIST",SEL,"I")
RXFINDX ; removed call ; ABSP*1.0T7*8 ; D REFRESH^DDSUTL
+1 QUIT -1
TTYPE() ; so what are you looking for?
+1 NEW PROMPT,DEFAULT,OPT,DISPLAY,CHOICES,TIMEOUT,ANS
+2 SET PROMPT="What kind of charge is this for? "
+3 SET DEFAULT="P"
SET OPT=1
SET DISPLAY="V"
+4 SET CHOICES="P:Prescription;N:Non-prescription item"
+5 SET TIMEOUT=$SELECT($GET(DTOUT):DTOUT,1:300)
+6 SET ANS=$$SET^ABSPOSU3(PROMPT,DEFAULT,OPT,DISPLAY,CHOICES,TIMEOUT)
+7 QUIT $SELECT(ANS="P":1,ANS="N":2,1:"")
WHICHRX(SEL) ; given ^TMP($J,"LIST" and SEL from visit selection,
+1 ; present another list to select which prescription
+2 ; TMP=count, TMP(RXI,RXR)=""
NEW TMP
MERGE TMP=^TMP($JOB,"LIST",SEL,"X")
+3 NEW VISIDESC
SET VISIDESC=^TMP($JOB,"LIST",SEL,"E")
+4 KILL ^TMP($JOB,"LIST")
SET ^TMP($JOB,"LIST",0)=0
+5 NEW TYPE
SET TYPE="S"
+6 NEW LISTROOT
SET LISTROOT="^TMP("_$JOB_",""LIST"","
+7 NEW X
SET X="1|Prescrip.:10,Drug:30,Fill Date:11,Quantity:10"
+8 SET ^TMP($JOB,"LIST","Column Headers")=X
+9 NEW TITLE
SET TITLE="Select a prescription for "_PATNAME_" from this visit"
+10 NEW PROMPT
SET PROMPT(1)=VISIDESC
+11 NEW OPT
SET OPT=1
+12 NEW ANSROOT
SET ANSROOT="^TMP($J,""ANS"","
KILL ^TMP($JOB,"ANS")
+13 NEW RXI,RXR
SET RXI=0
FOR
SET RXI=$ORDER(TMP(RXI))
IF 'RXI
QUIT
Begin DoDot:1
+14 SET RXR=""
FOR
SET RXR=$ORDER(TMP(RXI,RXR))
IF RXR=""
QUIT
Begin DoDot:2
+15 NEW N
SET (N,^TMP($JOB,"LIST",0))=^TMP($JOB,"LIST",0)+1
+16 NEW Z
SET Z=$GET(^PSRX(RXI,0))
+17 NEW DRUGIEN
SET DRUGIEN=$PIECE(Z,U,6)
+18 NEW DRUGNAME
IF DRUGIEN
SET DRUGNAME=$PIECE($GET(^PSDRUG(DRUGIEN,0)),U)
+19 IF '$TEST
SET DRUGIEN="?"
+20 NEW DATE,QTY
+21 IF RXR
Begin DoDot:3
+22 NEW Z
SET Z=$GET(^PSRX(RXI,1,RXR,0))
+23 SET DATE=$PIECE(Z,U)
+24 SET QTY=$PIECE(Z,U,4)
End DoDot:3
+25 IF '$TEST
Begin DoDot:3
+26 SET DATE=$PIECE($GET(^PSRX(RXI,2)),U,2)
+27 SET QTY=$PIECE(Z,U,7)
End DoDot:3
+28 NEW Y
SET Y=DATE
XECUTE ^DD("DD")
SET DATE=Y
+29 SET QTY=$$FMTQTY(QTY)
+30 NEW X
SET X=$$LJBF("`"_RXI,10)_" "_$$LJBF(DRUGNAME,30)
+31 SET X=X_" "_$$LJBF(DATE,11)_" "_$$LJBF($$FMTQTY(QTY),10)
+32 SET ^TMP($JOB,"LIST",N,"E")=X
+33 SET ^TMP($JOB,"LIST",N,"I")=RXI_U_RXR
End DoDot:2
End DoDot:1
+34 SET X=$$LIST^ABSPOSU4(TYPE,LISTROOT,ANSROOT,TITLE,.PROMPT,OPT)
+35 IF "^^"[X
QUIT ""
+36 IF X<0
QUIT ""
+37 ;IHS/OIT/RCS 7/8/2013 Patch 46 - Only allow one number from list to be selected
+38 IF X'?1N.N
QUIT ""
+39 QUIT X
FMTQTY(QTY) ; decimal, 3 places, but no excess trailing zeroes
+1 IF QTY#1=0
QUIT QTY_" "
+2 SET QTY=$JUSTIFY(QTY,0,3)
+3 IF QTY?.E1"."1N1"00"
SET $EXTRACT(QTY,$LENGTH(QTY)-1,$LENGTH(QTY))=" "
+4 IF '$TEST
IF QTY?.E1"."2N1"0"
SET $EXTRACT(QTY,$LENGTH(QTY))=" "
+5 QUIT QTY
VISIFIND(PAT,RXTYPE,VISITIEN) ; given patient IEN, present a list of visits
+1 ; if RXTYPE=1, then pick only visits which have prescriptions
+2 ; returns index of one selected, and ^TMP($J,"LIST",***) left over
+3 ; returns false if none selected
+4 ; VISITIEN'=0 means "this is the visit I want, fake it out as if it
+5 ; had been selected from the list."
+6 ;W "In VISIFIND with " ZW PAT,RXTYPE H 1
+7 IF $GET(PAT)
SET PATNAME=$PIECE(^DPT(PAT,0),U)
+8 ; single item selection
NEW TYPE
SET TYPE="S"
+9 NEW LISTROOT
SET LISTROOT="^TMP("_$JOB_",""LIST"","
KILL ^TMP($JOB,"LIST")
+10 NEW X
SET X="1|Visit:12,Date:14,Clinic:15,Prescriptions:25"
+11 SET ^TMP($JOB,"LIST","Column Headers")=X
+12 NEW ANSROOT
SET ANSROOT="^TMP("_$JOB_",""ANS"","
KILL ^TMP($JOB,"ANS")
+13 DO VISLIST(VISITIEN)
+14 NEW TITLE
SET TITLE="Select a visit"
+15 IF $GET(PAT)
SET TITLE=TITLE_" for "_PATNAME
+16 NEW PROMPT
SET PROMPT="Item number (^ to exit)"
+17 NEW OPT
SET OPT=1
+18 NEW X
+19 ; we specified it, we pretend we selected it
IF VISITIEN
SET X=1
+20 IF '$TEST
IF '^TMP($JOB,"LIST",0)
Begin DoDot:1
+21 WRITE PATNAME," has no visits on file.",!
End DoDot:1
SET X=""
+22 IF '$TEST
SET X=$$LIST^ABSPOSU4(TYPE,LISTROOT,ANSROOT,TITLE,PROMPT,OPT)
+23 IF "^^"[X
QUIT ""
+24 IF X<0
QUIT ""
+25 ;IHS/OIT/RCS 7/8/2013 Patch 46 - Only allow one number from list to be selected
+26 IF X'?1N.N
QUIT ""
+27 QUIT X
VISLIST(VISITIEN) ; set up LISTROOT ; given PAT ; if $$, it returns the count
+1 ; variations? haven't thought it through - for now, must have PAT
+2 NEW ROOT
SET ROOT=$EXTRACT(LISTROOT,1,$LENGTH(LISTROOT)-1)_")"
+3 SET @ROOT@(0)=0
+4 NEW TIME9
SET TIME9=""
+5 ; in reverse
FOR
SET TIME9=$ORDER(^AUPNVSIT("AA",PAT,TIME9))
IF 'TIME9
QUIT
Begin DoDot:1
+6 NEW VSTIEN
SET VSTIEN=0
+7 FOR
SET VSTIEN=$ORDER(^AUPNVSIT("AA",PAT,TIME9,VSTIEN))
IF VSTIEN=""
QUIT
Begin DoDot:2
+8 ; when we want only this one
IF $GET(VISITIEN)
IF VISITIEN'=VSTIEN
QUIT
+9 NEW VCN,DATE,CLINIC,DELETED,PRESC,RXI,RXR,Z,Y,X,N,RXINFO
+10 SET VCN=$PIECE($GET(^AUPNVSIT(VSTIEN,"VCN")),U)
+11 IF VCN=""
SET VCN="`"_VSTIEN
+12 SET Z=^AUPNVSIT(VSTIEN,0)
+13 ; deleted visit!
IF $PIECE(Z,U,11)
SET VCN="D!"_VCN
+14 SET Y=$PIECE(Z,U)
XECUTE ^DD("DD")
SET DATE=$PIECE(Y,"@")_"@"_$PIECE($PIECE(Y,"@",2),":")
+15 SET CLINIC=$PIECE(Z,U,8)
IF CLINIC
SET CLINIC=$PIECE($GET(^DIC(40.7,CLINIC,0)),U)
+16 ;
+17 ; don't store in @ROOT@(0) until you keep it
SET N=@ROOT@(0)+1
+18 ;
+19 DO VISRX(VSTIEN,$EXTRACT(ROOT,1,$LENGTH(ROOT)-1)_","_N_",""X"")")
+20 ;
+21 ; exactly one prescription - print drug name
IF @ROOT@(N,"X")=1
Begin DoDot:3
+22 SET RXI=$ORDER(@ROOT@(N,"X",""))
+23 SET RXINFO=$PIECE($GET(^PSRX(RXI,0)),U,6)
+24 IF RXINFO
SET RXINFO=$PIECE($GET(^PSDRUG(RXINFO,0)),U)
+25 IF RXINFO=""
SET RXINFO="missing data"
End DoDot:3
+26 ; more than 1 prescriptions
IF '$TEST
IF @ROOT@(N,"X")
Begin DoDot:3
+27 SET RXINFO=@ROOT@(N,"X")_" prescriptions"
End DoDot:3
+28 ; 0 prescriptions
IF '$TEST
Begin DoDot:3
+29 SET RXINFO="none"
End DoDot:3
+30 ; stop, we only want prescriptions
IF RXINFO="none"
IF RXTYPE=1
QUIT
+31 SET X=$$LJBF(VCN,12)
+32 SET X=X_" "_$$LJBF(DATE,15)
+33 SET X=X_" "_$$LJBF(CLINIC,15)
+34 SET X=X_" "_$$LJBF(RXINFO,25)
+35 SET @ROOT@(N,"E")=X
+36 SET @ROOT@(N,"I")=VSTIEN
+37 SET @ROOT@(0)=N
End DoDot:2
End DoDot:1
+38 IF $QUIT
QUIT @ROOT@(0)
QUIT
VISRX(VISIT,ROOT) ; build @ROOT=count of prescriptions for this visit
+1 ; @ROOT@(RXI,RXR)="" for each prescription
+2 ; Jump there via V MEDICATION
+3 IF '$DATA(@ROOT)
SET @ROOT=0
+4 NEW VMED
SET VMED=0
+5 FOR
SET VMED=$ORDER(^AUPNVMED("AD",VISIT,VMED))
IF VMED=""
QUIT
DO VMEDRX(VMED,ROOT)
+6 QUIT
VMEDRX(VMEDIEN,ROOT) ; called from VISRX
+1 NEW RXI,RXR
+2 SET RXI=0
FOR
SET RXI=$ORDER(^PSRX("APCC",VMEDIEN,RXI))
IF 'RXI
QUIT
Begin DoDot:1
+3 IF $DATA(^(RXI))=1
SET @ROOT@(RXI,0)=""
SET @ROOT=@ROOT+1
+4 IF '$TEST
SET RXR=0
FOR
SET RXR=$ORDER(^PSRX("APCC",VMEDIEN,RXI,RXR))
IF 'RXR
QUIT
Begin DoDot:2
+5 SET @ROOT@(RXI,RXR)=""
+6 SET @ROOT=@ROOT+1
End DoDot:2
End DoDot:1
+7 QUIT
PATFIND() ; return patient IEN, or false if none selected
+1 NEW DIC,Y,DUOUT,DTOUT,X,DLAYGO,DINUM,RETVAL
+2 SET DIC=2
SET DIC(0)="AEMNQZ"
+3 ;
+4 ; Removed this screen. If memory serves, this "C" index is not
+5 ; reliable. Besides, we need flexibility to find patients and visits
+6 ; which don't have prescription file entries, since we'll be entering
+7 ; non-prescription items, too.
+8 ; ,DIC("S")="I $D(^PSRX(""C"",Y))"
+9 ;
+10 ; lookup patient
DO ^DIC
+11 QUIT $SELECT(Y<0:"",1:+Y)
LJBF(X,N) QUIT $EXTRACT(X_$JUSTIFY("",N-$LENGTH(X)),1,N)
