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

DGRPLE.m

Go to the documentation of this file. 
  1. DGRPLE ;WAS/ERC/RMM,ALB/CKN - REGISTRATION EDITS OF PURPLE HEART FIELDS ; 11/22/05 4:13pm
  1.  ;;5.3;Registration;**314,343,377,431,653,688**;Aug 13, 1993;Build 29
  1.  ;
  1. DIV() ;Get Institution Name
  1.  ;If site is multi-divisional then ask user for division
  1.  ;
  1.  ; DBIA: #10112 - supported API $$SITE^VASITE and $$PRIM^VASITE
  1.  ;                for retrieving Institution name
  1.  ;
  1.  ; Input: none
  1.  ;
  1.  ; Output:  DGNAM - Institution name
  1.  ;
  1.  N DGDIV,DGSTN,DGNAM
  1.  S DGDIV=$S($D(^DG(40.8,"B")):$$MULTDIV,1:$$PRIM^VASITE)
  1.  S DGSTN=$$SITE^VASITE(,DGDIV)
  1.  S DGNAM=$S($P(DGSTN,U,2)]"":$P(DGSTN,U,2),1:"")
  1.  Q DGNAM
  1.  ;
  1. MULTDIV() ;User selects from active divisions
  1.  ;
  1.  ; Input: none
  1.  ;
  1.  ; Output:
  1.  ;      Function return value - Division IEN
  1.  ;
  1.  N DIR,X,Y
  1.  S DIR(0)="PA^40.8:EM"
  1.  S DIR("A")="Enter your division: "
  1.  S DIR("S")="I $$SITE^VASITE(,+Y)>0"
  1.  D ^DIR
  1.  Q +Y
  1.  ;
  1. EDITPOW(DG1,DG2,DG3,DG4,DGDFN) ;entry from enrollment for HEC updates
  1.  ;    DGDFN - Patient File IEN
  1.  ;    DG1   - POW Indicator
  1.  ;    DG2   - POW Confinement Location
  1.  ;    DG3   - POW From Date
  1.  ;    DG4   - POW To Date
  1.  ; Update POW data from HEC - DG*5.3*653
  1.  N DATA,DGENDA,ERROR,CURPOW,POW
  1.  S DGENDA=DGDFN
  1.  S CURPOW=$G(^DPT(DGDFN,.52))
  1.  S POW(.525)=$P(CURPOW,"^",5) ;Current POW indicator
  1.  S POW(.529)=$P(CURPOW,"^",9) ;Current POW verified status
  1.  S DATA(.525)=$G(DG1)
  1.  ;If Current POW Verified Status is null,
  1.  ;OR Current POW Verified Status is not null and incoming POW indicator is different than current POW indicator,
  1.  ;set POW Verified Status to current Date/Time.
  1.  I (POW(.529)="")!((POW(.529)'="")&(DG1'=POW(.525))) S DATA(.529)=$$NOW^XLFDT()
  1.  ;Remove the values in database if POW Indicator is NO
  1.  ;otherwise update new values
  1.  S DATA(.526)=$S(DG1="N":"@",1:DG2)
  1.  S DATA(.527)=$S(DG1="N":"@",1:DG3)
  1.  S DATA(.528)=$S(DG1="N":"@",1:DG4)
  1.  I '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR) D
  1.  . D ADDMSG^DGENUPL3(.MSGS,"Unable to update POW Data.",1)
  1.  K DATA,DGENDA,ERROR,DG1,DG2,DG3,DG4
  1.  Q
  1.  ;
  1. EDITPH(DG1,DG2,DG3,DGDFN) ;entry from enrollment for HEC updates
  1.  ;    DGDFN - Patient File IEN
  1.  ;    DG1   - PH Indicator
  1.  ;    DG2   - PH Status
  1.  ;    DG3   - PH Remarks
  1.  ;
  1.  N DATA,DGENDA,ERROR,DGUSER,DGPHARR,%
  1.  S DGENDA=DGDFN
  1.  S (DG(1),DATA(.531))=DG1
  1.  S (DG(2),DATA(.532))=$S(DG1="N":"",1:DG2)
  1.  S (DG(3),DATA(.533))=$S(DG1="Y":"",1:DG3)
  1.  I '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR) D
  1.  .D ADDMSG^DGENUPL3(.MSGS,"Unable to update Purple Heart Data.",1)
  1.  K DATA,DGENDA,ERROR
  1.  ; If the Database Server Failed, Quit.
  1.  Q:'$D(^DPT(DGDFN,.53))
  1.  S DGUSER="HEC User",DGPHARR=^DPT(DGDFN,.53)
  1.  ; If nothing was changed, don't update the history, Quit.
  1.  Q:'$$CHANGE(DG(1),DG(2),DG(3),DGDFN)
  1.  ;
  1.  D NOW^%DTC
  1.  S DATA(.01)=%,DATA(1)=DG(1),DATA(2)=DG(2),DATA(3)=DG(3)
  1.  S DATA(4)=DGUSER,DGENDA(1)=DGDFN
  1.  I '$$ADD^DGENDBS(2.0534,.DGENDA,.DATA,.ERROR) D
  1.  .D ADDMSG^DGENUPL3(.MSGS,"Unable to update Purple Heart History.",1)
  1.  K DATA,DGENDA,ERROR
  1.  ;
  1.  Q
  1.  ;
  1. EDITPH1(DGUSER) ;
  1.  ; Input:   DGUSER - Person filing Purple Heart changes
  1.  ;
  1.  ; Output:  none
  1.  ;
  1.  S DGUSER=$G(DGUSER,$P(^VA(200,DUZ,0),U))
  1.  NEW DGPHARR,DG,DGX
  1.  S DGPHARR=^DPT(DFN,.53)
  1.  ;REDIE will ensure there is a STATUS only if indicator is 
  1.  ;'yes' and a REMARK only if indicator is 'no'
  1.  I $P(DGPHARR,U)="Y",($P(DGPHARR,U,3)]"") D REDIE(3)
  1.  I $P(DGPHARR,U)="N",($P(DGPHARR,U,2)]"") D REDIE(2)
  1.  F DGX=1:1:3 S DG(DGX)=$P(DGPHARR,U,DGX)
  1.  I $$CHANGE(DG(1),DG(2),DG(3),DFN) D EDITPH2(DG(1),DG(2),DG(3),DGUSER)
  1.  Q
  1.  ;
  1. EDITPH2(DG1,DG2,DG3,DG4) ;stuff PH values into the PH multiple of file #2
  1.  S DFN=DA
  1.  N DA,DIC,DIE
  1.  S DIC="^DPT("_DFN_",""PH"","
  1.  S DA(1)=DFN
  1.  D NOW^%DTC S X=%
  1.  S DIC(0)="L"
  1.  S DIC("DR")="1///^S X=$G(DG1);2///^S X=$G(DG2);3///^S X=$G(DG3);4///^S X=$G(DG4)"
  1.  D ^DIC
  1.  Q
  1.  ;
  1. REDIE(DGPCE) ; make sure value in PH Status and PH Remarks consistent 
  1.  ; with value of PH Indicator
  1.  N DA,DIE,DR
  1.  S DIE="^DPT(",DR=$S($G(DGPCE)=2:.532,1:.533)_"///^S X=""@"""
  1.  S DA=DFN
  1.  D ^DIE
  1.  S DGPHARR=^DPT(DFN,.53)
  1.  Q
  1.  ;
  1. CHANGE(DGPH1,DGPH2,DGPH3,DGPHDFN) ;Check to see if the entry has changed
  1.  ; Input:
  1.  ;       DGPH1  - PH Indicator
  1.  ;       DGPH2  - PH Status
  1.  ;       DGPH3  - PH Remarks
  1.  ;       DGPHDFN- Patient file IEN
  1.  ;
  1.  ; Output:  none
  1.  ;
  1.  ; Return:  DGCHG = 1 - Change in any of the input values has occurred
  1.  ;          DGCHG = 0 - No change
  1.  ;
  1.  N DGCHG    ;Return value
  1.  N DGARR    ;Array containing last values from audit
  1.  N DGPHVAL  ;Merged array of DGARR
  1.  N DGERR    ;Error root for DIQ
  1.  N DGIEN    ;IEN of last audit value
  1.  N DGFILE   ;Purple Heart Multiple
  1.  N DGI      ;Index counter
  1.  ;
  1.  K DGPHINC
  1.  S DGCHG=0
  1.  S DGFILE=2.0534
  1.  S DGIEN=$O(^DPT(DGPHDFN,"PH","B"),-1)
  1.  I DGIEN="" S DGCHG=1 G AUDITQ
  1.  D GETS^DIQ(DGFILE,DGIEN_","_DGPHDFN_",","1;2;3","I","DGARR","DGERR")
  1.  I $D(DGERR) S DGCHG=1 G AUDITQ
  1.  M DGPHVAL=DGARR(DGFILE,DGIEN_","_DGPHDFN_",")
  1.  F DGI=1:1:3 I @("DGPH"_DGI)'=DGPHVAL(DGI,"I") D
  1.  . S DGCHG=1
  1.  . I DGI=1 D  ; PH INDICATOR has changed
  1.  . . I DGPH1="N",DGPHVAL(DGI,"I")="Y" S DGPHINC=1 ; Package Variable to note PH Indicator has changed
  1. AUDITQ Q DGCHG