BLRLINK2 ;IHS/DIR/FJE - CONT. OF BLR - IHS LABORATORY VISIT CREATION ; 22-Oct-2013 09:22 ; MKK
;;5.2;IHS LABORATORY;**1015,1024,1025,1027,1033**;NOV 01, 1997
;
EP ; EP
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EP^BLRLINK2 0.0")
D ENTRYAUD^BLRUTIL("EP^BLRLINK2 0.0","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
I $G(BLRVIEN),$G(BLRVFN),'$D(@($$GETGREF(BLRVFN)_BLRVIEN_")")) S (BLRVIEN,BLRVFN)="" D DTXVP^BLRLINK
I $G(PCCVISIT),$G(BLRVFN),$G(BLRVIEN) S BLRVGL=$$GETGREF(BLRVFN)_BLRVIEN_",0)",APCDALVR("APCDVSIT")=$P(@BLRVGL,U,3)
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("^BLRLINK2 5.0","APCDALVR")
D ENTRYAUD^BLRUTIL("EP^BLRLINK2 5.0","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
D VISIT:'PCCVISIT Q:BLRERR
D SETVISIT:'$D(APCDALVR("APCDVSIT"))
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EP^BLRLINK2 9.0")
D ENTRYAUD^BLRUTIL("EP^BLRLINK2 9.0","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
Q
;
VISIT ;CALLS APCDALV TO CREATE PCC VISIT
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 0.0","APCDALVR")
D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 0.0","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
I $D(^LRO(68.999999901,"AA",BLRPATCD)) S APCDALVR("APCDVSIT")=$O(^LRO(68.999999901,"AA",BLRPATCD,"")) D CHECK Q:BLRERR S PCCVISIT=1 Q
S APCDALVR("APCDAUTO")="",AUPNTALK="" ;FOR BACKGROUND VISIT CREATION
K DINUM,DLAYGO,DR,DIC,DA,D0,DIU,DIW,DIY,DIV ;IHS/ANMC/CLS 05/16/94 KILLS FILEMAN VARIABLES
; D ^APCDALV
; I $D(APCDALVR("APCDAFLG")) S BLRBUL=2,BLRPCC="PCC Visit not created APCDFLG = "_APCDALVR("APCDAFLG"),BLRERR=1 W:'BLRQUIET !,BLRPCC,! Q
;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
; Use GETVISIT^APCDAPI4 instead of D ^APCDALV
;
; It was requested that if a visit exists for the patient for that day, use
; that visit and don't create a new one unless no visit exists.
NEW BLRAPI4,OLDDUZ,OUT ; Make sure arrays don't stick around
D EP^BLRPCCVC ; Populate the new input array
;
M OLDDUZ=DUZ ; IHS/OIT/MKK LR*5.2*1027
D RESETDUZ^BLRPCCVC ; IHS/OIT/MKK LR*5.2*1027
;
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 2.0","BLRAPI4","APCDALVR")
D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 2.0","BLRAPI4","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
;
D GETVISIT^APCDAPI4(.BLRAPI4,.OUT) ; Call the PCC API
;
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 3.0","BLRAPI4","APCDALVR","OUT")
D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 3.0","BLRAPI4","APCDALVR","OUT") ; IHS/OIT/MKK - LR*5.2*1033
;
; If no Visit OR multiple visits found, then try to FORCE ADD a NEW visit.
; I +$G(OUT(0))=0&($O(OUT(0))="") D Q
;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
I +$G(OUT(0))=0!(+$G(OUT(0))>1) D
. ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
. D EP^BLRPCCVC ; Reset the Array
. K BLRAPI4("NEVER ADD") ; Delete "FLAG" LR*5.2*1027
. S BLRAPI4("FORCE ADD")=1 ; FORCE Visit Creation, if possible.
. ;
. ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 4.0","BLRAPI4","APCDALVR")
. D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 4.0","BLRAPI4","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
. ;
. D GETVISIT^APCDAPI4(.BLRAPI4,.OUT)
. ;
. ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 5.0","BLRAPI4","APCDALVR","OUT")
. D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 5.0","BLRAPI4","APCDALVR","OUT") ; IHS/OIT/MKK - LR*5.2*1033
;
;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1025
S TSTR="DUZ"_"=OLDDUZ"
; S @TSTR ; Change DUZ back
M @TSTR ; Change DUZ back -- LR*5.2*1027
;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1025
;
; Error if no Visit OR No Visit IEN OR multiple visit numbers, so quit
I +$G(OUT(0))=0!($O(OUT(0))="")!(+$G(OUT(0))>1) D Q
. NEW ERRMSG
. S ERRMSG=$P($G(OUT(0)),"^",2)
. S BLRBUL=2
. S BLRPCC="PCC Visit not created."
. I ERRMSG'="" S BLRPCC=BLRPCC_" "_ERRMSG
. S BLRERR=1
. W:'BLRQUIET !,BLRPCC,!
. ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 6.0")
. D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 6.0") ; IHS/OIT/MKK - LR*5.2*1033
;
; Visit exists; use the visit number
S APCDALVR("APCDVSIT")=$O(OUT(0))
;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
;
D CHECK Q:BLRERR
; 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
;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
; Change required by QA.
; Need to "kill" DO variable before using FILE^DICN
D ^XBFMK ; Clear ALL FileMan variables
K DO ; Clear DO (the letter Oh, not the # zero)
S DIC="^LRO(68.999999901,"
S DIC(0)="FL"
S DIC("DR")=".02////"_APCDALVR("APCDVSIT")_";.03////"_BLRORD
S DLAYGO=68.999999901
S DIADD=1
S X=BLRPATCD
K DD
D FILE^DICN
K DIC,DLAYGO,DIADD,DR
;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
;
S PCCVISIT=1
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 9.0")
D ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 9.0") ; IHS/OIT/MKK - LR*5.2*1033
Q
;
;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
; IF a visit is found in the LAB VA-IHS LINK file for the patient,
; then it is necessary to make sure that the ORDER NUMBER matches
; BEFORE using that visit. Note that the BLRPATCD variable is
; actually made up of the patient's IEN and the Collection Date.
FINDVIS(BLRPATCD) ; EP
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 0.0")
D ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 0.0") ; IHS/OIT/MKK - LR*5.2*1033
; If no visit in the LAB VA-IHS LINK file, then just return
I $D(^LRO(68.999999901,"AA",BLRPATCD))<1 Q 0
;
; At this point, it's known that at least one visit exists in the
; LAB VA-IHS LINK file. BUT only use the visit IF and ONLY IF it
; matches the Order Number.
NEW IEN,VIS,FLAG
S (VIS,FLAG)=0
F S VIS=$O(^LRO(68.999999901,"AA",BLRPATCD,VIS)) Q:VIS=""!(FLAG>0) D
. S IEN=0
. F S IEN=$O(^LRO(68.999999901,"AA",BLRPATCD,VIS,IEN)) Q:IEN=""!(FLAG>0) D
.. I $P($G(^LRO(68.999999901,IEN,0)),"^",3)=BLRORD S FLAG=VIS
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 8.0")
D ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 8.0") ; IHS/OIT/MKK - LR*5.2*1033
Q FLAG
;
;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
;
SETVISIT ;SET APCDALVR("APCDVSIT") IF '$D
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 0.0","APCDALVR")
D ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 0.0","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
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
I BLRL=180 S BLRERR=1,BLRBUL=2,BLRPCC="Visit not created - task terminated" W:'BLRQUIET !,BLRPCC,!
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 9.0")
D ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 9.0") ; IHS/OIT/MKK - LR*5.2*1033
Q
;
CHECK ; confirm that visit ien and patient match up
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 0.0","APCDALVR")
D ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 0.0","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
S BLRVSIT=$G(^AUPNVSIT(APCDALVR("APCDVSIT"),0))
I $P(BLRVSIT,U,5)'=BLRVADFN S BLRERR=1,BLRBUL=2,BLRPCC="Mismatch on visit and patient" W:'BLRQUIET !,BLRPCC,!
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 9.0")
D ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 9.0") ; IHS/OIT/MKK - LR*5.2*1033
Q
;
GETGREF(BLRX) ;
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GETGREF^BLRLINK2 0.0")
D ENTRYAUD^BLRUTIL("GETGREF^BLRLINK2 0.0")
Q $G(^DIC(BLRX,0,"GL"))
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
+2 ;
EP ; EP
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EP^BLRLINK2 0.0")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("EP^BLRLINK2 0.0","APCDALVR")
+3 IF $GET(BLRVIEN)
IF $GET(BLRVFN)
IF '$DATA(@($$GETGREF(BLRVFN)_BLRVIEN_")"))
SET (BLRVIEN,BLRVFN)=""
DO DTXVP^BLRLINK
+4 IF $GET(PCCVISIT)
IF $GET(BLRVFN)
IF $GET(BLRVIEN)
SET BLRVGL=$$GETGREF(BLRVFN)_BLRVIEN_",0)"
SET APCDALVR("APCDVSIT")=$PIECE(@BLRVGL,U,3)
+5 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("^BLRLINK2 5.0","APCDALVR")
+6 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("EP^BLRLINK2 5.0","APCDALVR")
+7 IF 'PCCVISIT
DO VISIT
IF BLRERR
QUIT
+8 IF '$DATA(APCDALVR("APCDVSIT"))
DO SETVISIT
+9 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EP^BLRLINK2 9.0")
+10 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("EP^BLRLINK2 9.0","APCDALVR")
+11 QUIT
+12 ;
VISIT ;CALLS APCDALV TO CREATE PCC VISIT
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 0.0","APCDALVR")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 0.0","APCDALVR")
+3 IF $DATA(^LRO(68.999999901,"AA",BLRPATCD))
SET APCDALVR("APCDVSIT")=$ORDER(^LRO(68.999999901,"AA",BLRPATCD,""))
DO CHECK
IF BLRERR
QUIT
SET PCCVISIT=1
QUIT
+4 ;FOR BACKGROUND VISIT CREATION
SET APCDALVR("APCDAUTO")=""
SET AUPNTALK=""
+5 ;IHS/ANMC/CLS 05/16/94 KILLS FILEMAN VARIABLES
KILL DINUM,DLAYGO,DR,DIC,DA,D0,DIU,DIW,DIY,DIV
+6 ; D ^APCDALV
+7 ; I $D(APCDALVR("APCDAFLG")) S BLRBUL=2,BLRPCC="PCC Visit not created APCDFLG = "_APCDALVR("APCDAFLG"),BLRERR=1 W:'BLRQUIET !,BLRPCC,! Q
+8 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
+9 ; Use GETVISIT^APCDAPI4 instead of D ^APCDALV
+10 ;
+11 ; It was requested that if a visit exists for the patient for that day, use
+12 ; that visit and don't create a new one unless no visit exists.
+13 ; Make sure arrays don't stick around
NEW BLRAPI4,OLDDUZ,OUT
+14 ; Populate the new input array
DO EP^BLRPCCVC
+15 ;
+16 ; IHS/OIT/MKK LR*5.2*1027
MERGE OLDDUZ=DUZ
+17 ; IHS/OIT/MKK LR*5.2*1027
DO RESETDUZ^BLRPCCVC
+18 ;
+19 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 2.0","BLRAPI4","APCDALVR")
+20 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 2.0","BLRAPI4","APCDALVR")
+21 ;
+22 ; Call the PCC API
DO GETVISIT^APCDAPI4(.BLRAPI4,.OUT)
+23 ;
+24 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 3.0","BLRAPI4","APCDALVR","OUT")
+25 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 3.0","BLRAPI4","APCDALVR","OUT")
+26 ;
+27 ; If no Visit OR multiple visits found, then try to FORCE ADD a NEW visit.
+28 ; I +$G(OUT(0))=0&($O(OUT(0))="") D Q
+29 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
+30 IF +$GET(OUT(0))=0!(+$GET(OUT(0))>1)
Begin DoDot:1
+31 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
+32 ; Reset the Array
DO EP^BLRPCCVC
+33 ; Delete "FLAG" LR*5.2*1027
KILL BLRAPI4("NEVER ADD")
+34 ; FORCE Visit Creation, if possible.
SET BLRAPI4("FORCE ADD")=1
+35 ;
+36 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 4.0","BLRAPI4","APCDALVR")
+37 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 4.0","BLRAPI4","APCDALVR")
+38 ;
+39 DO GETVISIT^APCDAPI4(.BLRAPI4,.OUT)
+40 ;
+41 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 5.0","BLRAPI4","APCDALVR","OUT")
+42 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 5.0","BLRAPI4","APCDALVR","OUT")
End DoDot:1
+43 ;
+44 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1025
+45 SET TSTR="DUZ"_"=OLDDUZ"
+46 ; S @TSTR ; Change DUZ back
+47 ; Change DUZ back -- LR*5.2*1027
MERGE @TSTR
+48 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1025
+49 ;
+50 ; Error if no Visit OR No Visit IEN OR multiple visit numbers, so quit
+51 IF +$GET(OUT(0))=0!($ORDER(OUT(0))="")!(+$GET(OUT(0))>1)
Begin DoDot:1
+52 NEW ERRMSG
+53 SET ERRMSG=$PIECE($GET(OUT(0)),"^",2)
+54 SET BLRBUL=2
+55 SET BLRPCC="PCC Visit not created."
+56 IF ERRMSG'=""
SET BLRPCC=BLRPCC_" "_ERRMSG
+57 SET BLRERR=1
+58 IF 'BLRQUIET
WRITE !,BLRPCC,!
+59 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 6.0")
+60 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 6.0")
End DoDot:1
QUIT
+61 ;
+62 ; Visit exists; use the visit number
+63 SET APCDALVR("APCDVSIT")=$ORDER(OUT(0))
+64 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
+65 ;
+66 DO CHECK
IF BLRERR
QUIT
+67 ; 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
+68 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
+69 ; Change required by QA.
+70 ; Need to "kill" DO variable before using FILE^DICN
+71 ; Clear ALL FileMan variables
DO ^XBFMK
+72 ; Clear DO (the letter Oh, not the # zero)
KILL DO
+73 SET DIC="^LRO(68.999999901,"
+74 SET DIC(0)="FL"
+75 SET DIC("DR")=".02////"_APCDALVR("APCDVSIT")_";.03////"_BLRORD
+76 SET DLAYGO=68.999999901
+77 SET DIADD=1
+78 SET X=BLRPATCD
+79 KILL DD
+80 DO FILE^DICN
+81 KILL DIC,DLAYGO,DIADD,DR
+82 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1024
+83 ;
+84 SET PCCVISIT=1
+85 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 9.0")
+86 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("VISIT^BLRLINK2 9.0")
+87 QUIT
+88 ;
+89 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
+90 ; IF a visit is found in the LAB VA-IHS LINK file for the patient,
+91 ; then it is necessary to make sure that the ORDER NUMBER matches
+92 ; BEFORE using that visit. Note that the BLRPATCD variable is
+93 ; actually made up of the patient's IEN and the Collection Date.
FINDVIS(BLRPATCD) ; EP
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 0.0")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 0.0")
+3 ; If no visit in the LAB VA-IHS LINK file, then just return
+4 IF $DATA(^LRO(68.999999901,"AA",BLRPATCD))<1
QUIT 0
+5 ;
+6 ; At this point, it's known that at least one visit exists in the
+7 ; LAB VA-IHS LINK file. BUT only use the visit IF and ONLY IF it
+8 ; matches the Order Number.
+9 NEW IEN,VIS,FLAG
+10 SET (VIS,FLAG)=0
+11 FOR
SET VIS=$ORDER(^LRO(68.999999901,"AA",BLRPATCD,VIS))
IF VIS=""!(FLAG>0)
QUIT
Begin DoDot:1
+12 SET IEN=0
+13 FOR
SET IEN=$ORDER(^LRO(68.999999901,"AA",BLRPATCD,VIS,IEN))
IF IEN=""!(FLAG>0)
QUIT
Begin DoDot:2
+14 IF $PIECE($GET(^LRO(68.999999901,IEN,0)),"^",3)=BLRORD
SET FLAG=VIS
End DoDot:2
End DoDot:1
+15 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 8.0")
+16 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("FINDVIS^BLRLINK2 8.0")
+17 QUIT FLAG
+18 ;
+19 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1022
+20 ;
SETVISIT ;SET APCDALVR("APCDVSIT") IF '$D
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 0.0","APCDALVR")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 0.0","APCDALVR")
+3 FOR BLRL=1:1:180
IF BLRL=180
QUIT
IF $DATA(^LRO(68.999999901,"AA",BLRPATCD))
SET APCDALVR("APCDVSIT")=$ORDER(^LRO(68.999999901,"AA",BLRPATCD,""))
SET PCCVISIT=1
IF $DATA(APCDALVR("APCDVSIT"))
QUIT
HANG 1
+4 IF BLRL=180
SET BLRERR=1
SET BLRBUL=2
SET BLRPCC="Visit not created - task terminated"
IF 'BLRQUIET
WRITE !,BLRPCC,!
+5 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 9.0")
+6 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("SETVISIT^BLRLINK2 9.0")
+7 QUIT
+8 ;
CHECK ; confirm that visit ien and patient match up
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 0.0","APCDALVR")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 0.0","APCDALVR")
+3 SET BLRVSIT=$GET(^AUPNVSIT(APCDALVR("APCDVSIT"),0))
+4 IF $PIECE(BLRVSIT,U,5)'=BLRVADFN
SET BLRERR=1
SET BLRBUL=2
SET BLRPCC="Mismatch on visit and patient"
IF 'BLRQUIET
WRITE !,BLRPCC,!
+5 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 9.0")
+6 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("CHECK^BLRLINK2 9.0")
+7 QUIT
+8 ;
GETGREF(BLRX) ;
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GETGREF^BLRLINK2 0.0")
+2 DO ENTRYAUD^BLRUTIL("GETGREF^BLRLINK2 0.0")
+3 QUIT $GET(^DIC(BLRX,0,"GL"))
