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

PSJINHIS.m

Go to the documentation of this file.
  1. PSJINHIS ;BIR/MLM-PRINT HISTORY LOG ;23 SEP 97 / 1:10 PM
  1. ;;5.0;INPATIENT MEDICATIONS;**267**;16 DEC 97;Build 158
  1. ;
  1. ; Reference to ^PS(55 is supported by DBIA 2191.
  1. ; Reference to ^%ZTLOAD is supported by DBIA 10063.
  1. ; Reference to ^%DTC is supported by DBIA 10000.
  1. ; Reference to ^%ZIS is supported by DBIA 10086.
  1. ; Reference to ^%ZISC is supported by DBIA 10089.
  1. ; Reference to ^DIR is supported by DBIA 10026.
  1. ;
  1. ENHIS(DFN,PSJHON,PSJHT) ; History log from beginning.
  1. N POP,X,ZTIO,ZTRTN
  1. W ! K IO("Q"),%ZIS,IOP S %ZIS="QM" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED" G K
  1. G:'$D(IO("Q")) DEQ K IO("Q"),ZTDTH,ZTSAVE,ZTSK S ZTIO=ION,ZTRTN="DEQ^PSJINHIS" F X="DFN","PSJHON","PSJHT","PSJORD","PSJSYSU","PSJSYSP" S ZTSAVE(X)="",ZTDESC="INPATIENT HISTORY LOG"
  1. D ^%ZTLOAD W:$D(ZTSK) !,"Queued."
  1. D HOME^%ZIS
  1. Q
  1. ;
  1. DEQ ; Entry from queue.
  1. N DIR,DONE,DTOUT,DUOUT,HDT,ON,ON55,P,PG,PPAGE,PSGORD,PSIVAC,PSJACNWP,PSJNEW,PSJPTR,UL80,PSJCHTO,PSJPR,PSJPRCOM,TMPTO,PN,PSJHDRF,%,ZTREQ,ZTQUEUED S PN=0
  1. S PSJCHTO="" S PSGP=DFN,PSJACNWP=1 D ENBOTH^PSJAC,NOW^%DTC S UL80="",$P(UL80,"-",80)="",HDT=$$ENDTC^PSGMI(%),PSJPTR=$E(IOST)'="C",PG=0,ON=PSJHON,PSIVAC="PH" U IO
  1. D RELATE,ENHEAD:PSJPTR W:'PSJPTR&($Y) @IOF I '$L(PSJOLD_PSJNEW) I $G(PSJORD) N PSGORD S PSGORD=PSJORD D EN0^PSJINVW(1,.PSJCHTO) G K
  1. S:'PSJOLD PSJOLD=PSJHON F S ON=PSJOLD D RELATE Q:PSJOLD=""
  1. F D DISPLAY,RELATE S ON=PSJNEW Q:PSJNEW=""!$D(DONE)
  1. ;
  1. K ; Kill and exit.
  1. K DFN,PSJHON,PSJHT,TMPTO
  1. W:$G(PSJPTR)&($Y) @IOF S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
  1. W !!
  1. Q
  1. ;
  1. DISPLAY ; Display order.
  1. S PSGORD=ON N PSJLM D EN0^PSJINVW(1,.PSJCHTO)
  1. Q
  1. ;
  1. PAUSE ; Hold screen.
  1. K DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) DONE=1
  1. Q
  1. RELATE ; Get related order.
  1. I ON["U"!(ON["A")!(ON["O") S PSJOLD=$P($G(^PS(55,DFN,5,+ON,0)),U,25),PSJNEW=$P($G(^(0)),U,26) Q
  1. I ON["V" S PSJOLD=$P($G(^PS(55,DFN,"IV",+ON,2)),U,5),PSJNEW=$P($G(^(2)),U,6) Q
  1. S PSJOLD=$P($G(^PS(53.1,+ON,0)),U,25),PSJNEW=$P($G(^(0)),U,26) I PSJNEW=ON S PSJNEW=""
  1. Q
  1. ;
  1. ENHEAD ; Header for Inpatient History log.
  1. S PPAGE=0 NEW PSJNEW D ENTRY^PSJHEAD(PSGP,0,0,0,0)
  1. Q