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

DGPHIST.m

Go to the documentation of this file. 
  1. DGPHIST ;WASH/ERC - PURPLE HEART REQUEST HISTORY ;23 AUG 00
  1.  ;;5.3;Registration;**343**,Aug 13, 19,1015**;;Build 21
  1.  ;
  1.  ;This report will show the Purple Heart Request history on a patient
  1.  Q
  1.  ;
  1. EN ;Entry point
  1.  N DGDFN,DGPAT,DGNAM,DGSSN
  1.  S DGDFN=$$GETDFN()
  1.  Q:DGDFN'>0
  1.  S DGPAT=$$GETPAT(DGDFN)
  1.  Q:$P(DGPAT,U)=""
  1.  S DGNAM=$P(DGPAT,U),DGSSN=$P(DGPAT,U,2)
  1.  I '$$PH(DGDFN) D  Q
  1.  . W !!,"There is no Purple Heart history for patient "_$G(DGNAM)_"."
  1.  . W !
  1.  . I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR
  1.  I $$DEVICE() D START
  1.  D EXIT
  1.  Q
  1.  ;
  1. GETDFN() ;Ask the user to select patient
  1.  ;
  1.  ; Input: none
  1.  ;
  1.  ; Output: DFN
  1.  ;
  1.  N DIC,X,Y
  1.  S DIC="^DPT(",DIC(0)="AEMQ"
  1.  D ^DIC
  1.  Q $S(+Y>0:+Y,1:0)
  1.  ;
  1. GETPAT(DFN) ; get patient name and ssn
  1.  ;
  1.  ; Input:  DFN - patient IEN
  1.  ;
  1.  ; Output:
  1.  ;      Function value:  patient name^SSN
  1.  ;
  1.  N VADM,DGNAM,DGSSN
  1.  S (DGNAM,DGSSN)=""
  1.  I $G(DFN)>0 D
  1.  . D ^VADPT
  1.  . S DGNAM=VADM(1)
  1.  . S DGSSN=$P(VADM(2),U,2)
  1.  Q DGNAM_"^"_DGSSN
  1.  ;
  1. PH(DGDFN1) ; does patient PH history exist
  1.  ;
  1.  ; Input:  DGDFN1 - Patient IEN
  1.  ;
  1.  ; Output:
  1.  ;    Function value:  0 - No PH Status history 
  1.  ;                     >0 - History exists
  1.  ;
  1.  Q $P($G(^DPT(DGDFN1,"PH",0)),U,3)>0
  1.  ;
  1. DEVICE() ;select output device
  1.  ;
  1.  ; Input: none
  1.  ;
  1.  ; Output: Function value    Interpretation
  1.  ;               0           User decides to queue or not print report.
  1.  ;               1           Device selected to generate report NOW.
  1.  ;
  1.  N OK,IOP,POP,%ZIS
  1.  S OK=1
  1.  S %ZIS="MQ"
  1.  D ^%ZIS
  1.  S:POP OK=0
  1.  I OK,$D(IO("Q")) D
  1.  . N ZTRTN,ZTDESC,ZTSAVE,ZTSK
  1.  . S ZTRTN="START^DGPHIST"
  1.  . S ZTDESC="Current PH Status Pending/In Process report."
  1.  . S ZTSAVE("DGDFN")=""
  1.  . S ZTSAVE("DGNAM")=""
  1.  . S ZTSAVE("DGSSN")=""
  1.  . F DG1=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
  1.  . W !,$S($D(ZTSK):"Request "_ZTSK_" Queued!",1:"Request Cancelled!"),!
  1.  . D HOME^%ZIS
  1.  . S OK=0
  1.  Q OK
  1.  ;
  1. START ;
  1.  U IO
  1.  N DGSITE,DGSTNUM,DGSTN,DGSTTN,DGDTN
  1.  S DGSITE=$$SITE^VASITE
  1.  S DGSTNUM=$P(DGSITE,U,3),DGSTN=$P(DGSITE,U,2)
  1.  S DGSTTN=$$NAME^VASITE(DT)
  1.  S DGDTN=$S($G(DGSTTN)]"":DGSTTN,1:$G(DGSTN))
  1.  D DATA
  1.  D EXIT
  1.  Q
  1.  ;
  1. DATA ;Build line data and print
  1.  ;
  1.  ; Division name retrieved from pointer to the INSTITUTION file (#4)
  1.  ; in PH DIVISION field (#.535) of PATIENT file (#2).
  1.  ; DBIA: #10090 - Supported read to the INSTITUTION file with FileMan
  1.  ;
  1.  N DGLINE,DGDATE,DGIND,DGSTAT,DGREM,DGUSER
  1.  N DGQUIT,DGPAGE,DGDIV
  1.  N DG1,DG2
  1.  S (DGPAGE,DGQUIT)=0
  1.  S DGDIV=$$GET1^DIQ(2,DGDFN,.535)
  1.  D HEAD
  1.  S DG1=0
  1.  F  S DG1=$O(^DPT(DGDFN,"PH",DG1)) Q:DG1'>0  D
  1.  . S DGLINE(DG1)=^DPT(DGDFN,"PH",DG1,0)
  1.  S DG2=0
  1.  F  S DG2=$O(DGLINE(DG2)) Q:DG2'>0  D
  1.  . D:$Y>(IOSL-4) HEAD Q:DGQUIT
  1.  . S DGDATE=$P($P(DGLINE(DG2),U),".")
  1.  . S DGDATE=$E(DGDATE,4,5)_"/"_$E(DGDATE,6,7)_"/"_$E(($E(DGDATE,1,3)+1700),3,4)
  1.  . S DGIND=$P(DGLINE(DG2),U,2)
  1.  . S DGIND=$S($G(DGIND)="Y":"Yes",$G(DGIND)="N":"No",1:"Unk")
  1.  . S DGSTAT=$P(DGLINE(DG2),U,3)
  1.  . S DGSTAT=$S($G(DGSTAT)="1":"Pending",$G(DGSTAT)="2":"In Process",$G(DGSTAT)="3":"Confirmed",1:"")
  1.  . S DGREM=$P(DGLINE(DG2),U,4)
  1.  . S DGREM=$S($G(DGREM)=1:"UNACCEPTABLE DOCUMENTATION",$G(DGREM)=2:"NO DOCUMENTATION REC'D",$G(DGREM)=3:"ENTERED IN ERROR",$G(DGREM)=4:"UNSUPPORTED PURPLE HEART",$G(DGREM)=5:"VAMC",$G(DGREM)=6:"UNDELIVERABLE MAIL",1:"")
  1.  . S DGUSER=$P(DGLINE(DG2),U,5)
  1.  . I $G(DGSTAT)["2"!($G(DGSTAT)["3") S DGUSER="HEC User"
  1.  . I $G(DGREM)]"",($G(DGREM)'["VAMC") S DGUSER="HEC User"
  1.  . W !,$G(DGDATE),?10,$G(DGIND),?15,$G(DGSTAT),?27,$G(DGREM),?55,$E($G(DGUSER),1,24)
  1.  W !!?30,"End of Report."
  1.  W !
  1.  I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR
  1.  Q
  1.  N DGDT
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
  1.  I $G(DGPAGE)>0 I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
  1.  Q:DGQUIT
  1.  W @IOF
  1.  S Y=DT X ^DD("DD") S DGDT=Y
  1.  S DGPAGE=$G(DGPAGE)+1
  1.  W !!,"PURPLE HEART REQUEST HISTORY REPORT",?48,DGDT,?70,"Page: ",$G(DGPAGE)
  1.  W !,"STATION: "_$G(DGSTN)
  1.  I DGDIV]"" W !,"DIVISION: ",DGDIV
  1.  W !,"_____________________________________________________________________________"
  1.  W !!,"Patient Name: "_$G(DGNAM),?55,"SSN: "_$G(DGSSN)
  1.  W !,"-----------------------------------------------------------------------------"
  1.  W !!,"Date",?10,"PH?",?15,"Status",?27,"Remarks",?55,"Updated By"
  1.  W !,"--------",?10,"---",?15,"----------",?27,"--------------------------",?55,"---------------"
  1.  Q
  1.  ;
  1. EXIT ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  I '$D(ZTQUEUED) D
  1.  . K %ZIS,POP
  1.  . D ^%ZISC,HOME^%ZIS
  1.  Q