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

BDGAPI1.m

Go to the documentation of this file. 
  1. BDGAPI1 ; IHS/ANMC/LJF - PATIENT MOVEMENT API'S ;  [ 06/19/2002  1:22 PM ]
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;
  1.  ;See BDGAPI for details on variables
  1.  ; Required for cancel function -
  1.  ;  BDGR("PAT")  = patient ien
  1.  ;  BDGR("TRAN") = ADT transaction
  1.  ;  BDGR("ACCT") = outside account #
  1.  ;  BDGR("DATE") = event date/time
  1.  ;
  1. CANCEL(BDGR) ;EP; silent API to delete patient movement entries to file 405
  1.  NEW DGQUIET,BDGAPI,ERR
  1.  S DGQUIET=1                ;must be in quiet mode
  1.  S BDGAPI=1                 ;let DGPMV rtns know using API
  1.  ;
  1.  S ERR=$$CHECK^BDGAPI(.BDGR) I ERR Q ERR   ;check common req fields
  1.  ;
  1.  D @BDGR("TRAN") I ERR Q ERR
  1.  Q $G(ERR)
  1.  ;
  1.  ;
  1. 1 ; delete admission
  1.  NEW DGPMT,DGPMP,DFN,I,DGPMCA,DGPMDA,BDGN,X,DGPMAN,DA,DGPMN
  1.  S DGPMT=BDGR("TRAN"),DFN=BDGR("PAT"),ERR="",DGPMN=0
  1.  ;
  1.  ; find admission based on acct #
  1.  ;6/19/2002 LJF9 (per Linda) change errors to warnings.
  1.  ;S BDGN=$$CA I $E(ERR,1)=1 Q
  1.  S BDGN=$$CA I '$G(BDGN) Q  ;IHS/ANMC/LJF 6/12/2002 if no IEN, quit no matter the reason
  1.  ;
  1.  ; set up BEFORE variables needed by event driver
  1.  S (DA,DGPMDA,DGPMCA)=BDGN,DGPMAN=$G(^DGPM(DA,0)) K %DT
  1.  S DGPMY=BDGR("ADMIT DATE"),DGPMP=DGPMAN
  1.  D VAR^DGPMV3 S DGPMER=0
  1.  ;
  1.  ; loop through other movements tied to admission and delete them
  1.  F DGI=DGPMDA:0 S DGI=$O(^DGPM("CA",DGPMDA,DGI)) Q:'DGI  D
  1.  . I $D(^DGPM(DGI,0)) D
  1.  .. S DGPMTYP=$P(^DGPM(DGI,0),"^",2),DA=DGI,DIK="^DGPM("
  1.  .. S ^UTILITY("DGPM",$J,DGPMTYP,DA,"P")=^DGPM(DGI,0),^UTILITY("DGPM",$J,DGPMTYP,DA,"A")=""
  1.  .. S ^UTILITY("DGPM",$J,DGPMTYP,DA,"IHSP")=$G(^DGPM(DGI,"IHS"))
  1.  .. S ^UTILITY("DGPM",$J,DGPMTYP,DA,"IHSA")=""
  1.  .. D ^DIK
  1.  ;
  1.  ; kill any treating specialty entry tied to admission
  1.  I DGPMDA,$O(^DGPM("APHY",DGPMDA,0)) D
  1.  . S DIK="^DGPM(",DA=+$O(^DGPM("APHY",DGPMDA,0))
  1.  . I $D(^DGPM(+DA,0)) D
  1.  .. S ^UTILITY("DGPM",$J,6,DA,"P")=^DGPM(DA,0),^UTILITY("DGPM",$J,6,DA,"A")=""
  1.  .. S ^UTILITY("DGPM",$J,6,DA,"IHSA")=""
  1.  .. S ^UTILITY("DGPM",$J,6,DA,"IHSP")=$G(^DGPM(+DA,"IHS"))
  1.  .. S Y=DA D PRIOR^DGPMV36,^DIK S Y=DA D AFTER^DGPMV36
  1.  ;
  1.  ; now delete admission
  1.  S DIK="^DGPM(",DA=DGPMDA D ^DIK
  1.  ;
  1.  ; set AFTER variables for event driver
  1.  S (^UTILITY("DGPM",$J,DGPMT,DGPMDA,"A"),DGPMA)=$G(^DGPM(+DGPMDA,0))
  1.  S ^UTILITY("DGPM",$J,DGPMT,DGPMDA,"IHSA")=$G(^DGPM(+DGPMDA,"IHS"))
  1.  ;
  1.  S DGOK=0 F I=0:0 S I=$O(^UTILITY("DGPM",$J,I)) Q:'I  F J=0:0 S J=$O(^UTILITY("DGPM",$J,I,J)) Q:'J  I (^(J,"A")'=^("P"))!($G(^("IHSA"))'=$G(^("IHSP"))) S DGOK=1 Q
  1.  I DGOK D ^DGPMEVT ;Invoke Movement Event Driver
  1.  D Q^DGPMV3        ;clean up event driver variables
  1.  ;
  1.  Q
  1.  ;
  1. 3 ; delete discharge
  1.  NEW DGPMT,DGPMP,DFN,I,DGPMCA,DGPMDA,BDGN,X,IEN,BDGV,BDGCA
  1.  S DGPMT=BDGR("TRAN"),DFN=BDGR("PAT"),ERR=""
  1.  ;
  1.  ; find admission based on acct # or admit date or current admit
  1.  D FINDADM^BDGAPI2
  1.  I 'BDGCA S ERR=ERR_2_U_"Cannot find file 405 entry for visit attached to acct # "_$G(BDGR("ACCT"))_U Q
  1.  S DGPMCA=BDGCA
  1.  ;
  1.  ; now find discharge entry
  1.  S BDGN=$$GET1^DIQ(405,DGPMCA,.17,"I")
  1.  I 'BDGN S ERR=1_U_"No discharge associated with account # "_$G(BDGR("ACCT")) Q
  1.  I $O(^DGPM("APTT1",DFN,BDGR("DISCHARGE DATE"))) S ERR=1_U_"Can only delete discharge for last admission; discharge ien="_BDGN Q
  1.  ;
  1.  ; set up BEFORE variables needed by event driver
  1.  S DGPMDA=BDGN K %DT
  1.  S ^UTILITY("DGPM",$J,DGPMT,DGPMDA,"IHSP")=$G(^DGPM(DGPMDA,"IHS"))
  1.  S DGPMER=0,(^UTILITY("DGPM",$J,DGPMT,DGPMDA,"P"),DGPMP)=^DGPM(DGPMDA,0)
  1.  ;
  1.  ;Delete discharge, update admission mvt
  1.  S DGPMADM=DGPMCA D DD^DGPMVDL1 K DA
  1.  ;
  1.  ; set AFTER variables for event driver
  1.  S (^UTILITY("DGPM",$J,DGPMT,DGPMDA,"A"),DGPMA)=$G(^DGPM(+DGPMDA,0))
  1.  S ^UTILITY("DGPM",$J,DGPMT,DGPMDA,"IHSA")=$G(^DGPM(+DGPMDA,"IHS"))
  1.  ;
  1.  S DGOK=0 F I=0:0 S I=$O(^UTILITY("DGPM",$J,I)) Q:'I  F J=0:0 S J=$O(^UTILITY("DGPM",$J,I,J)) Q:'J  I (^(J,"A")'=^("P"))!($G(^("IHSA"))'=$G(^("IHSP"))) S DGOK=1 Q
  1.  I DGOK D ^DGPMEVT ;Invoke Movement Event Driver
  1.  D Q^DGPMV3        ;clean up event driver variables
  1.  ;
  1.  Q
  1.  ;
  1.  ;LJF9 - everything coming out of this subroutine is an error, not a warning
  1. CA() ; find admission based on acct # or date
  1.  NEW X
  1.  S X=$O(^AUPNVSIT("AXT",+$G(BDGR("ACCT")),0))
  1.  I 'X S ERR=ERR_2_U_"Account # not in Visit file: "_$G(BDGR("ACCT"))_U
  1.  S BDGN=$O(^DGPM("AVISIT",+X,0))
  1.  ;6/19/2002 LJF9 (per Linda) change errors to warnings
  1.  ;I 'BDGN S ERR=ERR_2_U_"Cannot find file 405 entry for visit attached to acct # "_$G(BDGR("ACCT"))_U
  1.  ;
  1.  ; if cannot find using acct #, find via event date
  1.  I 'BDGN S BDGN=$O(^DGPM("APTT"_DGPMT,DFN,BDGR("DATE"),0))
  1.  ;6/19/2002 LJF9 (per Linda) change errors to warnings
  1.  ;I 'BDGN S ERR=1_U_"Cannot find entry using date or acct #; DATE="_BDGR("DATE")_" Acct #="_$G(BDGR("ACCT"))
  1.  I 'BDGN S ERR=2_U_"Cannot find entry using date or acct #; DATE="_BDGR("DATE")_" Acct #="_$G(BDGR("ACCT"))  ;IHS/ANMC/LJF 6/12/2002 LJF9
  1.  Q $G(BDGN)