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

BLRLINK2.m

Go to the documentation of this file. 
  1. BLRLINK2 ;IHS/DIR/FJE - CONT. OF BLR - IHS LABORATORY VISIT CREATION ; 22-Oct-2013 09:22 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1015,1024,1025,1027,1033**;NOV 01, 1997
  1.  ;
  1. EP ; EP
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EP^BLRLINK2 0.0")
  1.  D ENTRYAUD^BLRUTIL("EP^BLRLINK2 0.0","APCDALVR")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  I $G(BLRVIEN),$G(BLRVFN),'$D(@($$GETGREF(BLRVFN)_BLRVIEN_")")) S (BLRVIEN,BLRVFN)="" D DTXVP^BLRLINK
  1.  I $G(PCCVISIT),$G(BLRVFN),$G(BLRVIEN) S BLRVGL=$$GETGREF(BLRVFN)_BLRVIEN_",0)",APCDALVR("APCDVSIT")=$P(@BLRVGL,U,3)
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("^BLRLINK2 5.0","APCDALVR")
  1.  D ENTRYAUD^BLRUTIL("EP^BLRLINK2 5.0","APCDALVR")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  D VISIT:'PCCVISIT Q:BLRERR
  1.  D SETVISIT:'$D(APCDALVR("APCDVSIT"))
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EP^BLRLINK2 9.0")
  1.  D ENTRYAUD^BLRUTIL("EP^BLRLINK2 9.0","APCDALVR")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  Q
  1.  ;
  1. VISIT ;CALLS APCDALV TO CREATE PCC VISIT
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 0.0","APCDALVR")
  1.  D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 0.0","APCDALVR")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  I $D(^LRO(68.999999901,"AA",BLRPATCD)) S APCDALVR("APCDVSIT")=$O(^LRO(68.999999901,"AA",BLRPATCD,"")) D CHECK Q:BLRERR  S PCCVISIT=1 Q
  1.  S APCDALVR("APCDAUTO")="",AUPNTALK="" ;FOR BACKGROUND VISIT CREATION
  1.  K DINUM,DLAYGO,DR,DIC,DA,D0,DIU,DIW,DIY,DIV  ;IHS/ANMC/CLS 05/16/94 KILLS FILEMAN VARIABLES
  1.  ; D ^APCDALV
  1.  ; I $D(APCDALVR("APCDAFLG")) S BLRBUL=2,BLRPCC="PCC Visit not created APCDFLG = "_APCDALVR("APCDAFLG"),BLRERR=1 W:'BLRQUIET !,BLRPCC,! Q
  1.  ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
  1.  ; Use GETVISIT^APCDAPI4 instead of D ^APCDALV
  1.  ; 
  1.  ; It was requested that if a visit exists for the patient for that day, use
  1.  ; that visit and don't create a new one unless no visit exists.
  1.  NEW BLRAPI4,OLDDUZ,OUT                ; Make sure arrays don't stick around
  1.  D EP^BLRPCCVC                         ; Populate the new input array
  1.  ;
  1.  M OLDDUZ=DUZ                          ; IHS/OIT/MKK LR*5.2*1027
  1.  D RESETDUZ^BLRPCCVC                   ; IHS/OIT/MKK LR*5.2*1027
  1.  ;
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 2.0","BLRAPI4","APCDALVR")
  1.  D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 2.0","BLRAPI4","APCDALVR")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  ;
  1.  D GETVISIT^APCDAPI4(.BLRAPI4,.OUT)    ; Call the PCC API
  1.  ;
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 3.0","BLRAPI4","APCDALVR","OUT")
  1.  D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 3.0","BLRAPI4","APCDALVR","OUT")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  ;
  1.  ; If no Visit OR multiple visits found, then try to FORCE ADD a NEW visit.
  1.  ; I +$G(OUT(0))=0&($O(OUT(0))="") D  Q
  1.  ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
  1.  I +$G(OUT(0))=0!(+$G(OUT(0))>1) D
  1.  . ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
  1.  . D EP^BLRPCCVC                       ; Reset the Array
  1.  . K BLRAPI4("NEVER ADD")              ; Delete "FLAG" LR*5.2*1027
  1.  . S BLRAPI4("FORCE ADD")=1            ; FORCE Visit Creation, if possible.
  1.  . ;
  1.  . ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 4.0","BLRAPI4","APCDALVR")
  1.  . D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 4.0","BLRAPI4","APCDALVR")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  . ;
  1.  . D GETVISIT^APCDAPI4(.BLRAPI4,.OUT)
  1.  . ;
  1.  . ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 5.0","BLRAPI4","APCDALVR","OUT")
  1.  . D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 5.0","BLRAPI4","APCDALVR","OUT")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  ;
  1.  ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1025
  1.  S TSTR="DUZ"_"=OLDDUZ"
  1.  ; S @TSTR                          ; Change DUZ back
  1.  M @TSTR                          ; Change DUZ back -- LR*5.2*1027
  1.  ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1025
  1.  ;
  1.  ; Error if no Visit OR No Visit IEN OR multiple visit numbers, so quit
  1.  I +$G(OUT(0))=0!($O(OUT(0))="")!(+$G(OUT(0))>1) D  Q
  1.  . NEW ERRMSG
  1.  . S ERRMSG=$P($G(OUT(0)),"^",2)
  1.  . S BLRBUL=2
  1.  . S BLRPCC="PCC Visit not created."
  1.  . I ERRMSG'="" S BLRPCC=BLRPCC_" "_ERRMSG
  1.  . S BLRERR=1
  1.  . W:'BLRQUIET !,BLRPCC,!
  1.  . ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 6.0")
  1.  . D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 6.0")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  ;
  1.  ; Visit exists; use the visit number
  1.  S APCDALVR("APCDVSIT")=$O(OUT(0))
  1.  ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
  1.  ;
  1.  D CHECK Q:BLRERR
  1.  ; S DIC="^LRO(68.999999901,",DIC(0)="FL",DIC("DR")=".02////"_APCDALVR("APCDVSIT")_";.03////"_BLRORD,DLAYGO=68.999999901,DIADD=1,X=BLRPATCD K DD D FILE^DICN K DIC,DLAYGO,DIADD,DR
  1.  ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
  1.  ;      Change required by QA.
  1.  ;      Need to "kill" DO variable before using FILE^DICN
  1.  D ^XBFMK                         ; Clear ALL FileMan variables
  1.  K DO                             ; Clear DO (the letter Oh, not the # zero)
  1.  S DIC="^LRO(68.999999901,"
  1.  S DIC(0)="FL"
  1.  S DIC("DR")=".02////"_APCDALVR("APCDVSIT")_";.03////"_BLRORD
  1.  S DLAYGO=68.999999901
  1.  S DIADD=1
  1.  S X=BLRPATCD
  1.  K DD
  1.  D FILE^DICN
  1.  K DIC,DLAYGO,DIADD,DR
  1.  ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
  1.  ;
  1.  S PCCVISIT=1
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 9.0")
  1.  D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 9.0")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  Q
  1.  ;
  1.  ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
  1.  ; IF a visit is found in the LAB VA-IHS LINK file for the patient,
  1.  ; then it is necessary to make sure that the ORDER NUMBER matches
  1.  ; BEFORE using that visit.  Note that the BLRPATCD variable is
  1.  ; actually made up of the patient's IEN and the Collection Date.
  1. FINDVIS(BLRPATCD)      ; EP
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 0.0")
  1.  D ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 0.0")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  ; If no visit in the LAB VA-IHS LINK file, then just return
  1.  I $D(^LRO(68.999999901,"AA",BLRPATCD))<1 Q 0
  1.  ;
  1.  ; At this point, it's known that at least one visit exists in the
  1.  ; LAB VA-IHS LINK file.  BUT only use the visit IF and ONLY IF it
  1.  ; matches the Order Number.
  1.  NEW IEN,VIS,FLAG
  1.  S (VIS,FLAG)=0
  1.  F  S VIS=$O(^LRO(68.999999901,"AA",BLRPATCD,VIS))  Q:VIS=""!(FLAG>0)  D
  1.  . S IEN=0
  1.  . F  S IEN=$O(^LRO(68.999999901,"AA",BLRPATCD,VIS,IEN))  Q:IEN=""!(FLAG>0)  D
  1.  .. I $P($G(^LRO(68.999999901,IEN,0)),"^",3)=BLRORD S FLAG=VIS
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 8.0")
  1.  D ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 8.0")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  Q FLAG
  1.  ;
  1.  ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
  1.  ;
  1. SETVISIT ;SET APCDALVR("APCDVSIT") IF '$D
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 0.0","APCDALVR")
  1.  D ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 0.0","APCDALVR")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  F BLRL=1:1:180 Q:BLRL=180  S:$D(^LRO(68.999999901,"AA",BLRPATCD)) APCDALVR("APCDVSIT")=$O(^LRO(68.999999901,"AA",BLRPATCD,"")),PCCVISIT=1 Q:$D(APCDALVR("APCDVSIT"))  H 1
  1.  I BLRL=180 S BLRERR=1,BLRBUL=2,BLRPCC="Visit not created - task terminated" W:'BLRQUIET !,BLRPCC,!
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 9.0")
  1.  D ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 9.0")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  Q
  1.  ;
  1. CHECK ; confirm that visit ien and patient match up
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 0.0","APCDALVR")
  1.  D ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 0.0","APCDALVR")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  S BLRVSIT=$G(^AUPNVSIT(APCDALVR("APCDVSIT"),0))
  1.  I $P(BLRVSIT,U,5)'=BLRVADFN S BLRERR=1,BLRBUL=2,BLRPCC="Mismatch on visit and patient" W:'BLRQUIET !,BLRPCC,!
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 9.0")
  1.  D ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 9.0")   ; IHS/OIT/MKK - LR*5.2*1033
  1.  Q
  1.  ;
  1. GETGREF(BLRX)      ; 
  1.  ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GETGREF^BLRLINK2 0.0")
  1.  D ENTRYAUD^BLRUTIL("GETGREF^BLRLINK2 0.0")
  1.  Q $G(^DIC(BLRX,0,"GL"))