[613] | 1 | PPPPRT11 ;ALB/JFP - DISPLAY LOG FILE ENTRIES ; 3/20/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 | ; -- This routine displays entries in the PPP Log file
|
---|
| 6 | ;
|
---|
| 7 | DSPLOG(IDATE) ; -- List processor entry point
|
---|
| 8 | ;
|
---|
| 9 | ; This is the main entry point for calling the list manager
|
---|
| 10 | ;
|
---|
| 11 | ; Parameters:
|
---|
| 12 | ; IDATE - The the report will start displaying data from.
|
---|
| 13 | ;
|
---|
| 14 | N LSTARRAY,IDXARRAY,VALMCNT,STRTDTE
|
---|
| 15 | ;
|
---|
| 16 | ;
|
---|
| 17 | S STRTDTE=IDATE
|
---|
| 18 | S Y=STRTDTE D DD^%DT S BDATE=Y
|
---|
| 19 | S Y=DT D DD^%DT S EDATE=Y
|
---|
| 20 | ;
|
---|
| 21 | K XQORS,VALMEVL
|
---|
| 22 | D EN^VALM("PPP LOG DISPL")
|
---|
| 23 | Q
|
---|
| 24 | ;
|
---|
| 25 | INIT ; -- Collects all the data and builds the display array
|
---|
| 26 | ;
|
---|
| 27 | N X,Y,CNT,LOGDFN,LOGND,RTN,MSG,ICODE,CODE,DATE
|
---|
| 28 | N IUSER,EUSER,USER,TXTLINE
|
---|
| 29 | ;
|
---|
| 30 | ;
|
---|
| 31 | S LSTARRAY="^TMP(""PPPL5"",$J)"
|
---|
| 32 | S IDXARRAY="^TMP(""PPPIDX"",$J)"
|
---|
| 33 | ;
|
---|
| 34 | K @LSTARRAY,@IDXARRAY
|
---|
| 35 | ;
|
---|
| 36 | S (VALMCNT,CNT)=0
|
---|
| 37 | W !!,"Building display...this may take a moment"
|
---|
| 38 | F D D:CNT=0 NUL Q:(IDATE="")
|
---|
| 39 | .S IDATE=$O(^PPP(1020.4,"C",IDATE)) Q:IDATE=""
|
---|
| 40 | .S LOGDFN=0
|
---|
| 41 | .F D Q:(LOGDFN="")
|
---|
| 42 | ..S LOGDFN=$O(^PPP(1020.4,"C",IDATE,LOGDFN)) Q:LOGDFN=""
|
---|
| 43 | ..S LOGND(0)=$G(^PPP(1020.4,LOGDFN,0))
|
---|
| 44 | ..S RTN=$G(^PPP(1020.4,LOGDFN,1))
|
---|
| 45 | ..S MSG=$G(^PPP(1020.4,LOGDFN,2))
|
---|
| 46 | ..S ICODE=$P(LOGND(0),"^",1),CODE=""
|
---|
| 47 | ..S:ICODE'="" CODE=$P($G(^PPP(1020.6,ICODE,0)),"^",2)
|
---|
| 48 | ..S Y=$P(LOGND(0),"^",3)
|
---|
| 49 | ..D DD^%DT S DATE=Y
|
---|
| 50 | ..S IUSER=$P(LOGND(0),"^",4),EUSER=""
|
---|
| 51 | ..S:IUSER'="" USER=$P($G(^VA(200,IUSER,0)),"^",1)
|
---|
| 52 | ..D SETD
|
---|
| 53 | Q
|
---|
| 54 | ;
|
---|
| 55 | HDR ; -- Builds Header
|
---|
| 56 | S VALMHDR(1)=""
|
---|
| 57 | S VALMHDR(2)="Data extracted for "_BDATE_" to "_EDATE
|
---|
| 58 | Q
|
---|
| 59 | ;
|
---|
| 60 | NUL ; -- Sets null message
|
---|
| 61 | ;
|
---|
| 62 | S @LSTARRAY@(1,0)=""
|
---|
| 63 | S @LSTARRAY@(2,0)=" No entries found for "_BDATE_" to "_EDATE
|
---|
| 64 | S @LSTARRAY@(3,0)=""
|
---|
| 65 | S @LSTARRAY@(4,0)=" Press <RETURN> to continue"
|
---|
| 66 | S VALMCNT=4
|
---|
| 67 | Q
|
---|
| 68 | FNL ; -- Clean up
|
---|
| 69 | ;
|
---|
| 70 | K @LSTARRAY,@IDXARRAY
|
---|
| 71 | K IDATE,BDATE,EDATE
|
---|
| 72 | Q
|
---|
| 73 | ;
|
---|
| 74 | SETD ; -- Sets up display for line for list processor
|
---|
| 75 | S TXTLINE=" "
|
---|
| 76 | S CNT=CNT+1
|
---|
| 77 | S TXTLINE=$$SETFLD^VALM1(""_DATE,TXTLINE,"DATE")
|
---|
| 78 | S TXTLINE=$$SETFLD^VALM1(USER,TXTLINE,"USER")
|
---|
| 79 | S TXTLINE=$$SETFLD^VALM1(RTN,TXTLINE,"ROUTINE")
|
---|
| 80 | D SETL
|
---|
| 81 | S TXTLINE=$$SETSTR^VALM1(CODE_" "_MSG,"",1,79)
|
---|
| 82 | D SETL
|
---|
| 83 | S TXTLINE=$$SETSTR^VALM1(" ","",1,79)
|
---|
| 84 | D SETL
|
---|
| 85 | Q
|
---|
| 86 | ;
|
---|
| 87 | SETL ; -- Sets up list manager display array
|
---|
| 88 | S VALMCNT=VALMCNT+1
|
---|
| 89 | S @LSTARRAY@(VALMCNT,0)=$E(TXTLINE,1,79)
|
---|
| 90 | S @LSTARRAY@("IDX",VALMCNT,CNT)=""
|
---|
| 91 | S @IDXARRAY@(CNT)=VALMCNT
|
---|
| 92 | Q
|
---|
| 93 | ;
|
---|
| 94 | END ; -- End of code
|
---|
| 95 | Q
|
---|
| 96 | ;
|
---|