Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSGAH

PSGAH.m

Go to the documentation of this file. 
  1. PSGAH ;ALB/DRP - ADMINISTRATION HISTORY RPT ;29 Oct 2015 12:44 PM
  1.  ;;5.0;INPATIENT MEDICATIONS;**315,350**;16 DEC 97;Build 3
  1.  ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
  1.  ;
  1.  ;Call to MEDHIST^PSBUTL controlled by IA 6271
  1.  ;
  1.  Q
  1.  ;Routine is called by Hidden Actions Menu so DFN variable will be passed in from the Menu
  1. INIT ; Initialize Variables
  1.  I '$$PATCH^XPDUTL("PSB*3.0*83") W !,"Report not available until install of patch PSB*3.0*83" S TERM=1 D PAUSE Q
  1.  I ($G(ON)["V") W !,"AH Report cannot be run for this order. Use CPRS or BCMA to find Admin history." S TERM=1 D PAUSE Q
  1.  I ($G(ON)["P"),$P($G(^PS(53.1,+ON,0)),U,4)'["U" W !,"AH Report cannot be run for this order. Use CPRS or BCMA to find Admin history." S TERM=1 D PAUSE Q
  1.  Q:$G(DFN)=""
  1.  N PSGACAR,PSGQ,PSGORD,PSGOIEN,PSGSPCE,PSGMRT,PSGSCH,PSGDRNG,PSGLOC
  1.  N TERM,PSGACT,COUNT,PAGNO,PSGDSG,PSGIN
  1.  N $ESTACK,$ETRAP S $ETRAP="D ERRTRP^PSGAH" ;
  1.  S PSGOIEN=$G(PSGOPD) Q:'PSGOIEN
  1.  S $P(PSGSPCE," ",30)="",COUNT=0
  1.  D ENCV^PSGSETU Q:$D(XQUIT)
  1.  D FULL^VALM1,PRMTRNG,MAIN
  1.  K ^XTMP("PSGAH",$J)
  1.  Q
  1.  ;
  1. MAIN ; Main control
  1.  Q:$G(PSGQ)
  1.  D OPEN^%ZISUTL("PSGAH",,) I $G(POP) W !!,"Nothing queued to print.",! Q
  1.  S:$E(IOSL,1)'["9" TERM=$S($E($G(IOST),1,2)="C-":1,1:0)
  1.  U IO S PAGNO=0
  1.  ;Get OI then get all orders for OI within time frame determined by ?
  1.  D GETHIST D:$D(PSGACAR) GETORD
  1.  D PRNHDR,WRITE
  1.  W !!,"Press RETURN to continue....." R X:$G(DTIME) ;pause before returning to Detail screen
  1.  D CLOSE^%ZISUTL("PSGAH")
  1.  K POP
  1.  Q
  1.  ;
  1. GETORD ; Get order information
  1.  N I,STR,PSGCUR S I=0
  1.  F  S I=$O(PSGACAR(I)) Q:'I  D
  1.  . S STR=PSGACAR(I),PSGCUR=0,PSGIN=$P(STR,U,6),PSGLOC=$P(STR,U,5)
  1.  . Q:$P(STR,U,3)["V"
  1.  . S PSGORD=+$P(STR,U,3),PSGACT=$P(STR,U,2) S:PSGORD=+$G(ON) PSGCUR=1 ;ON passed in from Menu
  1.  . S PSGMRT=$P($G(^PS(55,DFN,5,PSGORD,0)),U,3),PSGMRT=$P(^PS(51.2,PSGMRT,0),U,1)
  1.  . S PSGSCH=$P($G(^PS(55,DFN,5,PSGORD,2)),U,1)
  1.  . S PSGDSG=$P($G(^PS(55,DFN,5,PSGORD,.2)),U,2)
  1.  . D SETTMP(I)        ;check and then set ^XTMP for sort
  1.  .Q
  1.  Q
  1.  ;
  1. GETHIST ; Get last 99 actions for each OI Dosage
  1.  ;MEDHIST(LIST,DFN,OI,MAX) ;Last nn admin actions per a patients Orderable Item
  1.  ; Input:
  1.  ;   DFN - Patient num
  1.  ;   OI  - Inpatient Meds Orderable Item ien
  1.  ;   MAX - Max days back to search
  1.  ; Output:
  1.  ;   LIST - Array of actions formatted as :
  1.  ;     DATE^ACTION^ORDNO^LSTSITE^LOCATION^NURSINITL
  1.  D MEDHIST^PSBUTL(.PSGACAR,DFN,PSGOIEN,PSGDRNG) ;ZW PSGACAR
  1.  Q
  1.  ;
  1.  ;The following items were requested for this new report:  
  1.  ;Dose. 
  1.  ;All administrations for the Orderable Item
  1.  ;Sorted by time. 
  1.  ;Grouped by all administrations by orderable item for that patient.
  1. SETTMP(ORDDT) ; Builds ^XTMP for sort
  1.  S ^XTMP("PSGAH",$J,ORDDT,PSGORD)=PSGDSG_U_PSGMRT_U_PSGSCH_$S(PSGCUR:"-Current",1:"")_U_PSGACT_U_PSGIN_U_PSGLOC
  1.  Q
  1.  ;
  1. WRITE ; WRITE records to output
  1.  ;        "DOSAGE ORDERD"_" "_MED ROUTE (INTERNAL)_" "_SCHEDULE(INTERNAL)_$S(CURRENT ORDER:"(*)",1:"")
  1.  N DATE,ORDER,STR S DATE=9999999
  1.  F  S DATE=$O(^XTMP("PSGAH",$J,DATE),-1) Q:DATE=""!$G(PSGQ)  D
  1.  . S ORDER=0
  1.  . F  S ORDER=$O(^XTMP("PSGAH",$J,DATE,ORDER)) Q:ORDER=""!$G(PSGQ)  D
  1.  ..S STR=^XTMP("PSGAH",$J,DATE,ORDER),PSGDSG=$P(STR,U,1),PSGMRT=$P(STR,U,2),PSGSCH=$P(STR,U,3),PSGACT=$P(STR,U,4)
  1.  ..S PSGIN=$P(STR,U,5),PSGLOC=$P(STR,U,6)
  1.  ..D PRNLN
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. PRNHDR ; Heading
  1.  Q:$G(PSGQ)
  1.  S PAGNO=PAGNO+1
  1.  W @IOF
  1.  W ! W:'$G(TERM) ?5 W $E($$FMTE^XLFDT($$NOW^XLFDT),1,18)
  1.  W ! W:'$G(TERM) ?5 W "Administration History for Orderable Item ",?73,"Page ",PAGNO
  1.  W ! W:'$G(TERM) ?10 W $G(PSGOPDN)
  1.  W ! W:'$G(TERM) ?5 W "Date             Action  Initials Location"
  1.  W ! W:'$G(TERM) ?8 W "Dosage Ordered                  Med Route     Schedule"
  1.  W ! W:'$G(TERM) ?5 W "---------------------------------------------------------------------------"
  1.  Q
  1.  ;
  1. PRNLN ;Write line on report
  1.  ;N ACTLBL S ACTLBL=$S(COUNT:"PREVIOUS ACTION "_COUNT_" ",1:"LAST ACTION: ")
  1.  W ! W:'$G(TERM) ?5 W $E($P($$FMTE^XLFDT(DATE,5),":",1,2)_PSGSPCE,1,16)_" "_$E(PSGACT_PSGSPCE,1,6)_"  "_$E(PSGIN_PSGSPCE,1,8)_" "_$G(PSGLOC,"UNKNOWN")
  1.  W ! W:'$G(TERM) ?8 W $E(PSGDSG_PSGSPCE,1,30)_"  "_$E(PSGMRT_PSGSPCE,1,12)_"  "_$E(PSGSCH_PSGSPCE,1,30),!
  1.  S COUNT=COUNT+1
  1.  I $Y>(IOSL-2) D:$G(TERM) PAUSE D PRNHDR
  1.  Q
  1.  ;
  1. PAUSE Q:'($G(TERM))
  1.  N X
  1.  U IO(0) W !!,"Press RETURN to continue, '^' to exit"
  1.  R X:$G(DTIME) I (X="^")!('$T) S PSGQ=1 Q
  1.  U IO
  1.  Q
  1. PRMTRNG ; prompt for number of Days back to return
  1.  K DIR,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S DIR(0)="N^1:99999:0"
  1.  S DIR("A")="Enter Number of days back to search",DIR("B")="14"
  1.  S DIR("?")="Enter an  '^' to exit this option now."
  1.  S DIR("?",1)="Enter the number days prior to today to search the BCMA MEDICATION LOG"
  1.  S DIR("?",2)="All BCMA orders within indicated range will be included"
  1.  S DIR("?",3)=""
  1.  S DIR("?",4)=""
  1.  D ^DIR S PSGDRNG=$S($D(DIRUT):0,1:Y) S:$D(DIRUT) PSGQ=1
  1.  K DIR,DIRUT,Y
  1.  Q
  1.  ;
  1. ERRTRP ; Error trap processing
  1.  N Z,PROBLEM
  1.  S Z(1,1)=$$EC^%ZOSV ; mumps error location and description
  1.  S Z="A SYSTEM ERROR HAS BEEN DETECTED AT THE FOLLOWING LOCATION"
  1.  S PROBLEM=7
  1.  D ^%ZTER ; record the error in the trap
  1.  G UNWIND^%ZTER ; unwind stack levels
  1.  Q