| 1 | PPPEDT12 ;ALB/JFP - EDIT FF XREF ROUTINE ;5/19/92
|
|---|
| 2 | ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; These routines control the display of foreign facility
|
|---|
| 6 | ; data via the list processor.
|
|---|
| 7 | ;
|
|---|
| 8 | DSPFF(PATDFN) ; List processor entry point
|
|---|
| 9 | ;
|
|---|
| 10 | ; This is the main entry point for calling the list processor.
|
|---|
| 11 | ;
|
|---|
| 12 | ; Parameters:
|
|---|
| 13 | ; PATDFN - The patient internal entry number
|
|---|
| 14 | ;
|
|---|
| 15 | N ARRAYNM,LSTARRAY,IDXARRAY,VALMCNT
|
|---|
| 16 | ;
|
|---|
| 17 | K XQORS,VALMEVL
|
|---|
| 18 | D EN^VALM("PPP XREF EDIT")
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | INIT ; Collect all of the data and build the display array
|
|---|
| 22 | ;
|
|---|
| 23 | N FFXIFN,PPPCNT,ERR
|
|---|
| 24 | ;
|
|---|
| 25 | S ARRAYNM="^TMP(""PPPTMP"",$J)"
|
|---|
| 26 | S LSTARRAY="^TMP(""PPPL1"",$J)"
|
|---|
| 27 | S IDXARRAY="^TMP(""PPPIDX"",$J)"
|
|---|
| 28 | ;
|
|---|
| 29 | K @ARRAYNM,@LSTARRAY,@IDXARRAY
|
|---|
| 30 | ;
|
|---|
| 31 | S (VALMCNT,PPPCNT)=0
|
|---|
| 32 | S FFXIFN=""
|
|---|
| 33 | I '$D(^PPP(1020.2,"B",PATDFN)) D NUL Q
|
|---|
| 34 | F S FFXIFN=$O(^PPP(1020.2,"B",PATDFN,FFXIFN)) Q:FFXIFN="" D
|
|---|
| 35 | .S ERR=$$GETFFX^PPPGET1(FFXIFN,ARRAYNM)
|
|---|
| 36 | .I ERR<0 D Q
|
|---|
| 37 | ..W !,*7,"An Unexpected Error Occurred...check error log"
|
|---|
| 38 | ..R !,"Press <RETURN> to exit...",TMP:DTIME
|
|---|
| 39 | ..S TMP=$$LOGEVNT^PPPMSC1(ERR,"INIT_PPPEDT12","GETFFX")
|
|---|
| 40 | .E D
|
|---|
| 41 | ..; - Format data for display
|
|---|
| 42 | ..S PPPCNT=$$SETD(FFXIFN,ARRAYNM,PPPCNT)
|
|---|
| 43 | ..I PPPCNT<1 D NUL
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | HDR ; Get header data and build it.
|
|---|
| 47 | ;
|
|---|
| 48 | N DIC,DA,DR,DIQ,DUOUT,DTOUT,PPPTMP
|
|---|
| 49 | S DIC="^DPT(",DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP" D EN^DIQ1
|
|---|
| 50 | S VALMHDR(1)=""
|
|---|
| 51 | S VALMHDR(2)="Patient: "_PPPTMP(2,PATDFN,.01)_" ("_PPPTMP(2,PATDFN,.09)_") DOB: "_PPPTMP(2,PATDFN,.03)
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | NUL ; Set null message
|
|---|
| 55 | ;
|
|---|
| 56 | S @LSTARRAY@(1,0)=" "
|
|---|
| 57 | S @LSTARRAY@(2,0)=" No Data found for the patient entered..."
|
|---|
| 58 | S @LSTARRAY@(3,0)=""
|
|---|
| 59 | S @LSTARRAY@(4,0)=" Select <AE> - Add Entry to make a NEW entry or <RETURN> to quit"
|
|---|
| 60 | S VALMCNT=4
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | FNL ; Clean Up
|
|---|
| 64 | ;
|
|---|
| 65 | K @ARRAYNM,@LSTARRAY,@IDXARRAY
|
|---|
| 66 | K PPPPNM
|
|---|
| 67 | K DIC,DIE,DR,DA
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | SETD(FFXIFN,TARRY,CNT) ; Sets up display line for list processor
|
|---|
| 71 | ;
|
|---|
| 72 | N PARMERR,TXTLINE
|
|---|
| 73 | ;
|
|---|
| 74 | S PARMERR=-9001
|
|---|
| 75 | ;
|
|---|
| 76 | I '$D(TARRY) Q PARMERR
|
|---|
| 77 | I '$D(CNT) Q PARMERR
|
|---|
| 78 | I '$D(@TARRY@(FFXIFN)) Q PARMERR
|
|---|
| 79 | ;
|
|---|
| 80 | S TXTLINE=" "
|
|---|
| 81 | S CNT=CNT+1
|
|---|
| 82 | S TXTLINE=$$SETFLD^VALM1(CNT,TXTLINE,"ENTRY")
|
|---|
| 83 | S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"POV")),TXTLINE,"INST")
|
|---|
| 84 | S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"DOMAIN")),TXTLINE,"DOMAIN")
|
|---|
| 85 | S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"LVD")),TXTLINE,"LDATE")
|
|---|
| 86 | ;S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"ED")),TXTLINE,"EDATE")
|
|---|
| 87 | D SETL
|
|---|
| 88 | Q CNT
|
|---|
| 89 | ;
|
|---|
| 90 | SETL ; -- Sets up list manager display array
|
|---|
| 91 | S VALMCNT=VALMCNT+1
|
|---|
| 92 | S @LSTARRAY@(VALMCNT,0)=$E(TXTLINE,1,79)
|
|---|
| 93 | S @LSTARRAY@("IDX",VALMCNT,CNT)=""
|
|---|
| 94 | S @IDXARRAY@(CNT)=VALMCNT_"^"_FFXIFN_"^"_$G(@TARRY@(FFXIFN,"NAME"))_"^"_$G(@TARRY@(FFXIFN,"STANO"))
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | END ; -- End of code
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
