100 lines
2.6 KiB
Mathematica
100 lines
2.6 KiB
Mathematica
PPPEDT12 ;ALB/JFP - EDIT FF XREF ROUTINE ;5/19/92
|
|
;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; These routines control the display of foreign facility
|
|
; data via the list processor.
|
|
;
|
|
DSPFF(PATDFN) ; List processor entry point
|
|
;
|
|
; This is the main entry point for calling the list processor.
|
|
;
|
|
; Parameters:
|
|
; PATDFN - The patient internal entry number
|
|
;
|
|
N ARRAYNM,LSTARRAY,IDXARRAY,VALMCNT
|
|
;
|
|
K XQORS,VALMEVL
|
|
D EN^VALM("PPP XREF EDIT")
|
|
Q
|
|
;
|
|
INIT ; Collect all of the data and build the display array
|
|
;
|
|
N FFXIFN,PPPCNT,ERR
|
|
;
|
|
S ARRAYNM="^TMP(""PPPTMP"",$J)"
|
|
S LSTARRAY="^TMP(""PPPL1"",$J)"
|
|
S IDXARRAY="^TMP(""PPPIDX"",$J)"
|
|
;
|
|
K @ARRAYNM,@LSTARRAY,@IDXARRAY
|
|
;
|
|
S (VALMCNT,PPPCNT)=0
|
|
S FFXIFN=""
|
|
I '$D(^PPP(1020.2,"B",PATDFN)) D NUL Q
|
|
F S FFXIFN=$O(^PPP(1020.2,"B",PATDFN,FFXIFN)) Q:FFXIFN="" D
|
|
.S ERR=$$GETFFX^PPPGET1(FFXIFN,ARRAYNM)
|
|
.I ERR<0 D Q
|
|
..W !,*7,"An Unexpected Error Occurred...check error log"
|
|
..R !,"Press <RETURN> to exit...",TMP:DTIME
|
|
..S TMP=$$LOGEVNT^PPPMSC1(ERR,"INIT_PPPEDT12","GETFFX")
|
|
.E D
|
|
..; - Format data for display
|
|
..S PPPCNT=$$SETD(FFXIFN,ARRAYNM,PPPCNT)
|
|
..I PPPCNT<1 D NUL
|
|
Q
|
|
;
|
|
HDR ; Get header data and build it.
|
|
;
|
|
N DIC,DA,DR,DIQ,DUOUT,DTOUT,PPPTMP
|
|
S DIC="^DPT(",DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP" D EN^DIQ1
|
|
S VALMHDR(1)=""
|
|
S VALMHDR(2)="Patient: "_PPPTMP(2,PATDFN,.01)_" ("_PPPTMP(2,PATDFN,.09)_") DOB: "_PPPTMP(2,PATDFN,.03)
|
|
Q
|
|
;
|
|
NUL ; Set null message
|
|
;
|
|
S @LSTARRAY@(1,0)=" "
|
|
S @LSTARRAY@(2,0)=" No Data found for the patient entered..."
|
|
S @LSTARRAY@(3,0)=""
|
|
S @LSTARRAY@(4,0)=" Select <AE> - Add Entry to make a NEW entry or <RETURN> to quit"
|
|
S VALMCNT=4
|
|
Q
|
|
;
|
|
FNL ; Clean Up
|
|
;
|
|
K @ARRAYNM,@LSTARRAY,@IDXARRAY
|
|
K PPPPNM
|
|
K DIC,DIE,DR,DA
|
|
Q
|
|
;
|
|
SETD(FFXIFN,TARRY,CNT) ; Sets up display line for list processor
|
|
;
|
|
N PARMERR,TXTLINE
|
|
;
|
|
S PARMERR=-9001
|
|
;
|
|
I '$D(TARRY) Q PARMERR
|
|
I '$D(CNT) Q PARMERR
|
|
I '$D(@TARRY@(FFXIFN)) Q PARMERR
|
|
;
|
|
S TXTLINE=" "
|
|
S CNT=CNT+1
|
|
S TXTLINE=$$SETFLD^VALM1(CNT,TXTLINE,"ENTRY")
|
|
S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"POV")),TXTLINE,"INST")
|
|
S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"DOMAIN")),TXTLINE,"DOMAIN")
|
|
S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"LVD")),TXTLINE,"LDATE")
|
|
;S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"ED")),TXTLINE,"EDATE")
|
|
D SETL
|
|
Q CNT
|
|
;
|
|
SETL ; -- Sets up list manager display array
|
|
S VALMCNT=VALMCNT+1
|
|
S @LSTARRAY@(VALMCNT,0)=$E(TXTLINE,1,79)
|
|
S @LSTARRAY@("IDX",VALMCNT,CNT)=""
|
|
S @IDXARRAY@(CNT)=VALMCNT_"^"_FFXIFN_"^"_$G(@TARRY@(FFXIFN,"NAME"))_"^"_$G(@TARRY@(FFXIFN,"STANO"))
|
|
Q
|
|
;
|
|
END ; -- End of code
|
|
Q
|
|
;
|