- AUPNVSIT ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ; 30 Sep 2010 2:13 PM
- ;;2.0;IHS PCC SUITE;**5,10,11**;MAY 14, 2009;Build 58
- ;IHS/CMI/LAB - added VCN entry point
- ;IHS/CMI/LAB - patch 14 added set of duz and dt to deleted visits
- ;fixed bgp to bdw
- ;
- VSIT01 ;EP;9000010,.01 (VISIT,VISIT/ADMIT DATE&TIME)
- I '$D(AUPNPAT) W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <No direct entry allowed>" K X Q
- I $D(AUPNDOB),$D(AUPNDOD),AUPNDOB,$D(DT),DT D VSIT01B Q
- I '$D(AUPNTALK),'$D(ZTQUEUED) W " <Required variables do not exist>"
- K X
- Q
- VSIT01B ;
- ;added check so that chart review visits can be created after DOD
- NEW S
- S S=$G(APCDCAT) I S="",$G(DA) S S=$P($G(^AUPNVSIT(DA,0)),U,7)
- I '$D(APCDFVOK),DT_".9999"<X W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <Future dates not allowed>" K X Q
- I DUZ("AG")="I",AUPNDOD,S'="C",$P(X,".",1)>AUPNDOD W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <Patient died before this date>" K X Q
- I $P(X,".",1)<AUPNDOB W:'$D(AUPNTALK)&('$D(ZTQUEUED)) " <Patient born after this date>" K X Q
- Q
- ;
- POSTSLCT ;
- S AUPNVSIT=+Y,AUPNY=Y
- I '$D(AUPNPAT),$P(^AUPNVSIT(AUPNVSIT,0),U,5) S Y=$P(^(0),U,5) D ^AUPNPAT
- S Y=AUPNY K AUPNY
- Q
- ;
- ADD ; ADD TO DEPENDENCY COUNT
- L +^AUPNVSIT(X,0):10 E W:'$D(ZTQUEUED) !!,"VISIT locked. Notify programmer!",! Q
- S:$P(^AUPNVSIT(X,0),U,9)<0 $P(^(0),U,9)=0
- S $P(^AUPNVSIT(X,0),U,9)=$P(^AUPNVSIT(X,0),U,9)+1 ;,$P(^(0),U,11)="" ;*** WILL NOT UNDELETE ***
- I $D(^AUPNVSIT("AMFI",X)),^AUPNVSIT("AMFI",X)="M"
- E I DUZ'=".5",$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V",$P(^AUPNVSIT(X,0),U,15)'="A",$P(^(0),U,15)'="D" S $P(^AUPNVSIT(X,0),U,15)="M",^AUPNVSIT("AMFI",X)="M"
- L -^AUPNVSIT(X,0)
- Q
- SUB ; SUBTRACT FROM DEPENDENCY COUNT
- L +^AUPNVSIT(X,0):10 E W:'$D(ZTQUEUED) !!,"VISIT locked. Notify programmer!",! Q
- S $P(^AUPNVSIT(X,0),U,9)=$P(^AUPNVSIT(X,0),U,9)-1 ;S:$P(^(0),U,9)<1 $P(^(0),U,11)=1 *** DON'T DELETE ***
- I $P(^AUPNVSIT(X,0),U,9)<0 S $P(^(0),U,9)=0 ; Should not happen but does
- I $P(^AUPNVSIT(X,0),U,15)="A"
- E I DUZ'=.5,$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V" S $P(^AUPNVSIT(X,0),U,15)="D",^AUPNVSIT("AMFI",X)="D"
- L -^AUPNVSIT(X,0)
- Q
- ;
- MOD ;PEP;MODIFY A VISIT OR V FILE ENTRY
- ;*******CANNOT BE CALLED FROM DIE **********CALLS DIE
- Q:$G(AUPNVSIT)=""
- Q:AUPNVSIT<0
- Q:'$D(^AUPNVSIT(AUPNVSIT,0))
- S DA=AUPNVSIT,DIE="^AUPNVSIT(",DR=".13////"_DT D ^DIE K DA,DIE,DIU,DIV,DR
- ;SET FACE TO FACE MAPPING OF SNOMED
- D FTF^AUPNMAP
- D WHSEEN^AUPNMAP
- ;SET PRIMARY SNOMED BASED ON THE FOLLOWING
- ;IF ANY ARE MARKED AS PRIMARY, SET THAT ONE, OTHERWISE SET THE FIRST ONE
- D SETPRIM^AUPNMAP
- I $O(^AMERVSIT("AD",AUPNVSIT,""))]"",$T(SYNC^AMERPOV)]"" D EN^XBNEW("SYNC^AMERPOV","AUPNVSIT") ;amer/bedd
- I $T(A08^BTSEVENT)]"" D A08
- I $$BH(AUPNVSIT) D QBHV
- ;the following updates MFI information
- Q:'$D(^AUTTSITE(1,0))
- Q:$P(^AUTTSITE(1,0),U,16)'="V"
- Q:DUZ=.5
- I $P(^AUPNVSIT(AUPNVSIT,0),U,15)'="A",$P(^(0),U,15)'="D" S DR=".15///M",DA=AUPNVSIT,DIE="^AUPNVSIT(" D ^DIE
- K DIE,DA,DR,DIU,DIV
- Q
- BH(V) ;
- ;is this a BH visit from EHR or PCC d/e that needs to be moved to BH?
- ;clinic=14, 46, 48, C4
- ;or provider discipline equals one of the codes in the BH PROVIDER CLASS CODE file
- I $T(EN^AMHEHR)="" Q 0 ;bh patch 8 not installed yet
- NEW C,%,G
- S C=$$CLINIC^APCLV(V,"C")
- I C=14!(C=43)!(C=48)!(C="C4")!(C="C9") Q 1 ;clinic code
- S (G,%)=0
- F S %=$O(^AUPNVPRV("AD",V,%)) Q:%'=+%!(G) D
- .S C=$P($G(^AUPNVPRV(%,0)),U)
- .Q:C=""
- .S C=$P($G(^VA(200,C,"PS")),U,5)
- .Q:C=""
- .S C=$P($G(^DIC(7,C,9999999)),U)
- .Q:C=""
- .I $D(^AMHBHPC("C",C)) S G=1 ;provider class
- .Q
- Q G
- ;
- QBHV ;queue BH visit creation/update to background
- ;if visit was created by BH then quit
- Q:$T(EN^AMHEHR)=""
- NEW G,ZTSK,ZTRTN,ZTSAVE,ZTDESC,ZTIO,ZTDTH
- S G=$O(^AMHREC("AVISIT",AUPNVSIT,0))
- I G,$P($G(^AMHREC(G,11)),U,11) Q ;this visit was created by BH
- I "ACHINRT"'[$P(^AUPNVSIT(AUPNVSIT,0),U,7) Q ;only these service categories are applicable
- I '$D(^AUPNVPRV("AD",AUPNVSIT)) Q
- I '$D(^AUPNVPOV("AD",AUPNVSIT)) Q
- I $T(EN^AMHEHR)]"" D EN^XBNEW("EN^AMHEHR","AUPNVSIT") Q
- Q
- ;queue to background ????
- Q:$T(EN^AMHEHR)=""
- F %="AUPNVSIT" S ZTSAVE(%)=""
- S ZTRTN="EN^AMHEHR"
- S ZTDESC="BH VISIT CREATION FROM EHR/PCC"
- S ZTIO=""
- S ZTDTH=$H
- D ^%ZTLOAD
- K ZTSK
- Q
- ;*******CANNOT BE CALLED FROM DIE**********CALLS DIE
- DEL ;EP;*** EXTERNAL ENTRY POINT *** SET DELETE FLAG
- ; The following exclusive NEW excepted from SAC by the Director, DSD. Request dated 12.14.92. No suspense was mandated.
- N (DT,DUZ,AUPNVSIT,U)
- I $P(^AUPNVSIT(AUPNVSIT,0),U,9) S AUPNVSIT=-1 Q
- S DIK="^AUPNVSIT(",DA=AUPNVSIT,X=2 D DD^DIK,1^DIK1
- S DA=AUPNVSIT,DR=".11///1;1117////"_$$NOW^XLFDT,DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR ;IHS/CMI/LAB - ADDED DATE TO 1117
- I $G(DUZ) S $P(^AUPNVSIT(AUPNVSIT,0),U,27)=DUZ ;IHS/CMI/LAB - store user who deleted in .27
- I $G(DT) S $P(^AUPNVSIT(AUPNVSIT,0),U,13)=DT ;IHS/CMI/LAB - visits being deleted w dec
- I $G(DT)]"" S ^AUPNVSIT("APCIS",DT,AUPNVSIT)="" ;IHS/CMI/LAB for apcp patch 6 send deletes
- I $G(DT),$P($G(^BDWSITE(1,0)),U,2)]"",DT>$P(^BDWSITE(1,0),U,2) S ^AUPNVSIT("ADWO",DT,AUPNVSIT)="" ;IHS/CMI/LAB - for data warehouse deletes.
- I $P($G(^AUPNVSIT(AUPNVSIT,22)),U,1)="" S $P(^AUPNVSIT(AUPNVSIT,22),U,1)="UNKNOWN/NON DATA ENTRY"
- I DUZ'=.5,$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V",$P(^AUPNVSIT(AUPNVSIT,0),U,15)="A" S DA=AUPNVSIT,DR=".15///@",DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR Q
- I DUZ'=.5,$D(^AUTTSITE(1,0)),$P(^AUTTSITE(1,0),U,16)="V",$P(^AUPNVSIT(AUPNVSIT,0),U,15)'="A" S DA=AUPNVSIT,DR=".15///D",DIE="^AUPNVSIT(" D ^DIE K DA,DIE,DR Q
- Q
- ;
- VCN(AUPNVSIT,AUPNADD) ;EP; *** EXTERNAL ENTRY POINT ***
- ; Returns Visit Control Number (VCN) on visit if already there
- ; Creates VCN and adds to visit if AUPNADD set to 1
- ; Returns a number if VCN found or created; returns "" if not
- ; If asked to add VCN and failed, 2nd piece VCN = error code:msg
- ;
- ; VCN = patient ien + . + running count for patient+1 + last digit of pseudo code for the site (ex. 234.56)
- ; Running count for patient is stored in ^AUPNVSIT("AVCN",DFN)
- ;
- ; Due to call to DICN an exclusive NEW is used
- ;
- NEW X
- I '$G(AUPNVSIT) Q $S($G(AUPNADD)=1:"^1:INVALID VISIT IEN",1:"")
- S X=$P($G(^AUPNVSIT(AUPNVSIT,11)),U,3) I X Q X ;VCN already there
- I $G(AUPNADD)'=1 Q X ;return result if add not an option
- ;
- NEW (DT,DUZ,U,AUPNVSIT,AUPNADD) ;SAC Exemption on file as of August 31, 2007 per email from Mike Danielson
- Q:'$G(^AUPNVSIT(AUPNVSIT,0)) "^1:INVALID VISIT IEN"
- Q:$P(^AUPNVSIT(AUPNVSIT,0),U,11)=1 "^2:DELETED VISIT"
- S DFN=$P(^AUPNVSIT(AUPNVSIT,0),U,5) Q:'DFN "^3:INVALID PATIENT ON VISIT"
- Q:'$G(^AUPNPAT(DFN,0)) "^3:INVALID PATIENT ON VISIT"
- ; Q:"ASORH"'[$P(^AUPNVSIT(AUPNVSIT,0),U,7) "^4:INVALID SERVICE CATEGORY" ;IHS/ASDST/GTH AUPN*99.1*7 02/15/2002
- ;Q:"ASORHT"'[$P(^AUPNVSIT(AUPNVSIT,0),U,7) "^4:INVALID SERVICE CATEGORY" ;add telephone per ANMC;IHS/ASDST/GTH AUPN*99.1*7 02/15/2002;IHS/SET/GTH AUPN*99.1*8 10/04/2002
- Q:"ASORHTC"'[$P(^AUPNVSIT(AUPNVSIT,0),U,7) "^4:INVALID SERVICE CATEGORY" ;add telephone per ANMC;IHS/ASDST/GTH AUPN*99.1*7 02/15/2002;IHS/SET/GTH AUPN*99.1*8 10/04/2002
- ;
- ;if vcn already exists, add to count until a good one is found
- ;S COUNT=$P(^AUPNPAT(DFN,0),U,37) ;last VCN
- ;F S COUNT=COUNT+1 Q:COUNT>99999 Q:'$D(^AUPNVSIT("VCN",DFN_"."_COUNT))
- S COUNT=+$G(^AUPNVSIT("AVCN",DFN))
- S ALPHA=$$ALPHA(AUPNVSIT) I ALPHA="" Q "^7:NO PSEUDO PREFIX FOR SITE"
- I ALPHA=+ALPHA Q "^8:INVALID PSEUDO PREFIX FOR SITE"
- F S COUNT=COUNT+1 Q:'$D(^AUPNVSIT("VCN",DFN_"."_COUNT_ALPHA))
- I COUNT>99999 Q "^5:LAST VCN INVALID"
- S AUPNVCN=DFN_"."_COUNT_ALPHA
- ;
- S DIE="^AUPNVSIT(",DA=AUPNVSIT,DR="1103///"_AUPNVCN D ^DIE
- I $P($G(^AUPNVSIT(AUPNVSIT,11)),U,3)'=AUPNVCN Q "^6:DIE CALL FAILED:"_AUPNVCN
- Q AUPNVCN
- ;
- ALPHA(VISIT) ; - returns 3rd character of pseudo prefix form encounter location
- NEW X
- S X=$P($G(^AUPNVSIT(+$G(VISIT),0)),U,6) I 'X Q ""
- Q $E($P($G(^AUTTLOC(X,1)),U,2),3)
- ;
- ;begin new code IHS/ASDST/GTH AUPN*99.1*7 02/15/2002
- UID(VISIT) ;EP - generate unique ID for visit
- I '$G(VISIT) Q VISIT
- NEW X
- I '$P($G(^AUTTSITE(1,1)),"^",3) S $P(^AUTTSITE(1,1),"^",3)=$P(^AUTTLOC($P(^AUTTSITE(1,0),"^",1),0),"^",10)
- S X=$P(^AUTTSITE(1,1),"^",3)
- Q X_$$LZERO(VISIT,10)
- ;
- LZERO(V,L) ;EP - left zero fill
- NEW %,I
- S %=$L(V),Z=L-% F I=1:1:Z S V="0"_V
- Q V
- ;end new code IHS/ASDST/GTH AUPN*99.1*7 02/15/2002
- ;
- INACLOC(Y) ;EP - return 1 if inactive, 0 if active
- I $G(Y)="" Q 1
- ;check to see if location of encounter is inactive based on visit date
- NEW X
- S X=$$CHKLOC(Y)
- I $D(^AUTTLOC(Y))
- Q X
- CHKLOC(Y) ; SCREEN OUT E CODES AND INACTIVE CODES
- I $D(DIFGLINE) Q 0
- I $D(ACHSDIEN) Q 0
- I $G(DUZ("AG"))'="I" Q 0
- NEW A,I,D
- S I=$P(^AUTTLOC(Y,0),U,21) ;inactive date
- S D="" I $G(APCDVSIT),$D(^AUPNVSIT(APCDVSIT)) S D=$P($P(^AUPNVSIT(APCDVSIT,0),U),".")
- ;check date if have date
- I $G(APCDDATE),I]"",APCDDATE>I Q 1 ;have date, date after inactive date
- I D]"",I]"",D>I Q 1
- ;if have no date to check then check 21st piece
- I '$G(APCDVSIT),'$G(APCDDATE),$P(^AUTTLOC(Y,0),U,21) Q 1
- Q 0
- ;
- A08 ;EP - for BTS per Christy Smith, Daou 5/12/05
- Q:'$G(AUPNVSIT)
- S AUPNHLER=$$A08^BTSEVENT(AUPNVSIT)
- K AUPNHLER
- Q
- ;
- MFI(Y) ;EP - called to determine whether a visit is an MFI visit
- I 'Y Q ""
- I '$D(^AUPNVSIT(Y)) Q ""
- I $D(DIFGLINE) Q 1
- I $P($G(^AUPNVSIT(Y,11)),U,13) Q 1
- I $P($G(^AUPNVSIT(Y,0)),U,23)=.5 Q 1
- Q ""
- ;
- UIDV(VISIT) ;EP - generate unique ID for visit
- I '$G(VISIT) Q VISIT
- NEW X
- ;I '$P($G(^AUTTSITE(1,1)),"^",3) S $P(^AUTTSITE(1,1),"^",3)=$P(^AUTTLOC($P(^AUTTSITE(1,0),"^",1),0),"^",10)
- S X=$$GET1^DIQ(9999999.06,$P(^AUTTSITE(1,0),U),.32)
- I X="" S X="00000"
- Q X_$$LZERO(VISIT,10)
- AUPNVSIT ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ; 30 Sep 2010 2:13 PM
- +1 ;;2.0;IHS PCC SUITE;**5,10,11**;MAY 14, 2009;Build 58
- +2 ;IHS/CMI/LAB - added VCN entry point
- +3 ;IHS/CMI/LAB - patch 14 added set of duz and dt to deleted visits
- +4 ;fixed bgp to bdw
- +5 ;
- VSIT01 ;EP;9000010,.01 (VISIT,VISIT/ADMIT DATE&TIME)
- +1 IF '$DATA(AUPNPAT)
- IF '$DATA(AUPNTALK)&('$DATA(ZTQUEUED))
- WRITE " <No direct entry allowed>"
- KILL X
- QUIT
- +2 IF $DATA(AUPNDOB)
- IF $DATA(AUPNDOD)
- IF AUPNDOB
- IF $DATA(DT)
- IF DT
- DO VSIT01B
- QUIT
- +3 IF '$DATA(AUPNTALK)
- IF '$DATA(ZTQUEUED)
- WRITE " <Required variables do not exist>"
- +4 KILL X
- +5 QUIT
- VSIT01B ;
- +1 ;added check so that chart review visits can be created after DOD
- +2 NEW S
- +3 SET S=$GET(APCDCAT)
- IF S=""
- IF $GET(DA)
- SET S=$PIECE($GET(^AUPNVSIT(DA,0)),U,7)
- +4 IF '$DATA(APCDFVOK)
- IF DT_".9999"<X
- IF '$DATA(AUPNTALK)&('$DATA(ZTQUEUED))
- WRITE " <Future dates not allowed>"
- KILL X
- QUIT
- +5 IF DUZ("AG")="I"
- IF AUPNDOD
- IF S'="C"
- IF $PIECE(X,".",1)>AUPNDOD
- IF '$DATA(AUPNTALK)&('$DATA(ZTQUEUED))
- WRITE " <Patient died before this date>"
- KILL X
- QUIT
- +6 IF $PIECE(X,".",1)<AUPNDOB
- IF '$DATA(AUPNTALK)&('$DATA(ZTQUEUED))
- WRITE " <Patient born after this date>"
- KILL X
- QUIT
- +7 QUIT
- +8 ;
- POSTSLCT ;
- +1 SET AUPNVSIT=+Y
- SET AUPNY=Y
- +2 IF '$DATA(AUPNPAT)
- IF $PIECE(^AUPNVSIT(AUPNVSIT,0),U,5)
- SET Y=$PIECE(^(0),U,5)
- DO ^AUPNPAT
- +3 SET Y=AUPNY
- KILL AUPNY
- +4 QUIT
- +5 ;
- ADD ; ADD TO DEPENDENCY COUNT
- +1 LOCK +^AUPNVSIT(X,0):10
- IF '$TEST
- IF '$DATA(ZTQUEUED)
- WRITE !!,"VISIT locked. Notify programmer!",!
- QUIT
- +2 IF $PIECE(^AUPNVSIT(X,0),U,9)<0
- SET $PIECE(^(0),U,9)=0
- +3 ;,$P(^(0),U,11)="" ;*** WILL NOT UNDELETE ***
- SET $PIECE(^AUPNVSIT(X,0),U,9)=$PIECE(^AUPNVSIT(X,0),U,9)+1
- +4 IF $DATA(^AUPNVSIT("AMFI",X))
- IF ^AUPNVSIT("AMFI",X)="M"
- +5 IF '$TEST
- IF DUZ'=".5"
- IF $DATA(^AUTTSITE(1,0))
- IF $PIECE(^AUTTSITE(1,0),U,16)="V"
- IF $PIECE(^AUPNVSIT(X,0),U,15)'="A"
- IF $PIECE(^(0),U,15)'="D"
- SET $PIECE(^AUPNVSIT(X,0),U,15)="M"
- SET ^AUPNVSIT("AMFI",X)="M"
- +6 LOCK -^AUPNVSIT(X,0)
- +7 QUIT
- SUB ; SUBTRACT FROM DEPENDENCY COUNT
- +1 LOCK +^AUPNVSIT(X,0):10
- IF '$TEST
- IF '$DATA(ZTQUEUED)
- WRITE !!,"VISIT locked. Notify programmer!",!
- QUIT
- +2 ;S:$P(^(0),U,9)<1 $P(^(0),U,11)=1 *** DON'T DELETE ***
- SET $PIECE(^AUPNVSIT(X,0),U,9)=$PIECE(^AUPNVSIT(X,0),U,9)-1
- +3 ; Should not happen but does
- IF $PIECE(^AUPNVSIT(X,0),U,9)<0
- SET $PIECE(^(0),U,9)=0
- +4 IF $PIECE(^AUPNVSIT(X,0),U,15)="A"
- +5 IF '$TEST
- IF DUZ'=.5
- IF $DATA(^AUTTSITE(1,0))
- IF $PIECE(^AUTTSITE(1,0),U,16)="V"
- SET $PIECE(^AUPNVSIT(X,0),U,15)="D"
- SET ^AUPNVSIT("AMFI",X)="D"
- +6 LOCK -^AUPNVSIT(X,0)
- +7 QUIT
- +8 ;
- MOD ;PEP;MODIFY A VISIT OR V FILE ENTRY
- +1 ;*******CANNOT BE CALLED FROM DIE **********CALLS DIE
- +2 IF $GET(AUPNVSIT)=""
- QUIT
- +3 IF AUPNVSIT<0
- QUIT
- +4 IF '$DATA(^AUPNVSIT(AUPNVSIT,0))
- QUIT
- +5 SET DA=AUPNVSIT
- SET DIE="^AUPNVSIT("
- SET DR=".13////"_DT
- DO ^DIE
- KILL DA,DIE,DIU,DIV,DR
- +6 ;SET FACE TO FACE MAPPING OF SNOMED
- +7 DO FTF^AUPNMAP
- +8 DO WHSEEN^AUPNMAP
- +9 ;SET PRIMARY SNOMED BASED ON THE FOLLOWING
- +10 ;IF ANY ARE MARKED AS PRIMARY, SET THAT ONE, OTHERWISE SET THE FIRST ONE
- +11 DO SETPRIM^AUPNMAP
- +12 ;amer/bedd
- IF $ORDER(^AMERVSIT("AD",AUPNVSIT,""))]""
- IF $TEXT(SYNC^AMERPOV)]""
- DO EN^XBNEW("SYNC^AMERPOV","AUPNVSIT")
- +13 IF $TEXT(A08^BTSEVENT)]""
- DO A08
- +14 IF $$BH(AUPNVSIT)
- DO QBHV
- +15 ;the following updates MFI information
- +16 IF '$DATA(^AUTTSITE(1,0))
- QUIT
- +17 IF $PIECE(^AUTTSITE(1,0),U,16)'="V"
- QUIT
- +18 IF DUZ=.5
- QUIT
- +19 IF $PIECE(^AUPNVSIT(AUPNVSIT,0),U,15)'="A"
- IF $PIECE(^(0),U,15)'="D"
- SET DR=".15///M"
- SET DA=AUPNVSIT
- SET DIE="^AUPNVSIT("
- DO ^DIE
- +20 KILL DIE,DA,DR,DIU,DIV
- +21 QUIT
- BH(V) ;
- +1 ;is this a BH visit from EHR or PCC d/e that needs to be moved to BH?
- +2 ;clinic=14, 46, 48, C4
- +3 ;or provider discipline equals one of the codes in the BH PROVIDER CLASS CODE file
- +4 ;bh patch 8 not installed yet
- IF $TEXT(EN^AMHEHR)=""
- QUIT 0
- +5 NEW C,%,G
- +6 SET C=$$CLINIC^APCLV(V,"C")
- +7 ;clinic code
- IF C=14!(C=43)!(C=48)!(C="C4")!(C="C9")
- QUIT 1
- +8 SET (G,%)=0
- +9 FOR
- SET %=$ORDER(^AUPNVPRV("AD",V,%))
- IF %'=+%!(G)
- QUIT
- Begin DoDot:1
- +10 SET C=$PIECE($GET(^AUPNVPRV(%,0)),U)
- +11 IF C=""
- QUIT
- +12 SET C=$PIECE($GET(^VA(200,C,"PS")),U,5)
- +13 IF C=""
- QUIT
- +14 SET C=$PIECE($GET(^DIC(7,C,9999999)),U)
- +15 IF C=""
- QUIT
- +16 ;provider class
- IF $DATA(^AMHBHPC("C",C))
- SET G=1
- +17 QUIT
- End DoDot:1
- +18 QUIT G
- +19 ;
- QBHV ;queue BH visit creation/update to background
- +1 ;if visit was created by BH then quit
- +2 IF $TEXT(EN^AMHEHR)=""
- QUIT
- +3 NEW G,ZTSK,ZTRTN,ZTSAVE,ZTDESC,ZTIO,ZTDTH
- +4 SET G=$ORDER(^AMHREC("AVISIT",AUPNVSIT,0))
- +5 ;this visit was created by BH
- IF G
- IF $PIECE($GET(^AMHREC(G,11)),U,11)
- QUIT
- +6 ;only these service categories are applicable
- IF "ACHINRT"'[$PIECE(^AUPNVSIT(AUPNVSIT,0),U,7)
- QUIT
- +7 IF '$DATA(^AUPNVPRV("AD",AUPNVSIT))
- QUIT
- +8 IF '$DATA(^AUPNVPOV("AD",AUPNVSIT))
- QUIT
- +9 IF $TEXT(EN^AMHEHR)]""
- DO EN^XBNEW("EN^AMHEHR","AUPNVSIT")
- QUIT
- +10 QUIT
- +11 ;queue to background ????
- +12 IF $TEXT(EN^AMHEHR)=""
- QUIT
- +13 FOR %="AUPNVSIT"
- SET ZTSAVE(%)=""
- +14 SET ZTRTN="EN^AMHEHR"
- +15 SET ZTDESC="BH VISIT CREATION FROM EHR/PCC"
- +16 SET ZTIO=""
- +17 SET ZTDTH=$HOROLOG
- +18 DO ^%ZTLOAD
- +19 KILL ZTSK
- +20 QUIT
- +21 ;*******CANNOT BE CALLED FROM DIE**********CALLS DIE
- DEL ;EP;*** EXTERNAL ENTRY POINT *** SET DELETE FLAG
- +1 ; The following exclusive NEW excepted from SAC by the Director, DSD. Request dated 12.14.92. No suspense was mandated.
- +2 NEW (DT,DUZ,AUPNVSIT,U)
- +3 IF $PIECE(^AUPNVSIT(AUPNVSIT,0),U,9)
- SET AUPNVSIT=-1
- QUIT
- +4 SET DIK="^AUPNVSIT("
- SET DA=AUPNVSIT
- SET X=2
- DO DD^DIK
- DO 1^DIK1
- +5 ;IHS/CMI/LAB - ADDED DATE TO 1117
- SET DA=AUPNVSIT
- SET DR=".11///1;1117////"_$$NOW^XLFDT
- SET DIE="^AUPNVSIT("
- DO ^DIE
- KILL DA,DIE,DR
- +6 ;IHS/CMI/LAB - store user who deleted in .27
- IF $GET(DUZ)
- SET $PIECE(^AUPNVSIT(AUPNVSIT,0),U,27)=DUZ
- +7 ;IHS/CMI/LAB - visits being deleted w dec
- IF $GET(DT)
- SET $PIECE(^AUPNVSIT(AUPNVSIT,0),U,13)=DT
- +8 ;IHS/CMI/LAB for apcp patch 6 send deletes
- IF $GET(DT)]""
- SET ^AUPNVSIT("APCIS",DT,AUPNVSIT)=""
- +9 ;IHS/CMI/LAB - for data warehouse deletes.
- IF $GET(DT)
- IF $PIECE($GET(^BDWSITE(1,0)),U,2)]""
- IF DT>$PIECE(^BDWSITE(1,0),U,2)
- SET ^AUPNVSIT("ADWO",DT,AUPNVSIT)=""
- +10 IF $PIECE($GET(^AUPNVSIT(AUPNVSIT,22)),U,1)=""
- SET $PIECE(^AUPNVSIT(AUPNVSIT,22),U,1)="UNKNOWN/NON DATA ENTRY"
- +11 IF DUZ'=.5
- IF $DATA(^AUTTSITE(1,0))
- IF $PIECE(^AUTTSITE(1,0),U,16)="V"
- IF $PIECE(^AUPNVSIT(AUPNVSIT,0),U,15)="A"
- SET DA=AUPNVSIT
- SET DR=".15///@"
- SET DIE="^AUPNVSIT("
- DO ^DIE
- KILL DA,DIE,DR
- QUIT
- +12 IF DUZ'=.5
- IF $DATA(^AUTTSITE(1,0))
- IF $PIECE(^AUTTSITE(1,0),U,16)="V"
- IF $PIECE(^AUPNVSIT(AUPNVSIT,0),U,15)'="A"
- SET DA=AUPNVSIT
- SET DR=".15///D"
- SET DIE="^AUPNVSIT("
- DO ^DIE
- KILL DA,DIE,DR
- QUIT
- +13 QUIT
- +14 ;
- VCN(AUPNVSIT,AUPNADD) ;EP; *** EXTERNAL ENTRY POINT ***
- +1 ; Returns Visit Control Number (VCN) on visit if already there
- +2 ; Creates VCN and adds to visit if AUPNADD set to 1
- +3 ; Returns a number if VCN found or created; returns "" if not
- +4 ; If asked to add VCN and failed, 2nd piece VCN = error code:msg
- +5 ;
- +6 ; VCN = patient ien + . + running count for patient+1 + last digit of pseudo code for the site (ex. 234.56)
- +7 ; Running count for patient is stored in ^AUPNVSIT("AVCN",DFN)
- +8 ;
- +9 ; Due to call to DICN an exclusive NEW is used
- +10 ;
- +11 NEW X
- +12 IF '$GET(AUPNVSIT)
- QUIT $SELECT($GET(AUPNADD)=1:"^1:INVALID VISIT IEN",1:"")
- +13 ;VCN already there
- SET X=$PIECE($GET(^AUPNVSIT(AUPNVSIT,11)),U,3)
- IF X
- QUIT X
- +14 ;return result if add not an option
- IF $GET(AUPNADD)'=1
- QUIT X
- +15 ;
- +16 ;SAC Exemption on file as of August 31, 2007 per email from Mike Danielson
- NEW (DT,DUZ,U,AUPNVSIT,AUPNADD)
- +17 IF '$GET(^AUPNVSIT(AUPNVSIT,0))
- QUIT "^1:INVALID VISIT IEN"
- +18 IF $PIECE(^AUPNVSIT(AUPNVSIT,0),U,11)=1
- QUIT "^2:DELETED VISIT"
- +19 SET DFN=$PIECE(^AUPNVSIT(AUPNVSIT,0),U,5)
- IF 'DFN
- QUIT "^3:INVALID PATIENT ON VISIT"
- +20 IF '$GET(^AUPNPAT(DFN,0))
- QUIT "^3:INVALID PATIENT ON VISIT"
- +21 ; Q:"ASORH"'[$P(^AUPNVSIT(AUPNVSIT,0),U,7) "^4:INVALID SERVICE CATEGORY" ;IHS/ASDST/GTH AUPN*99.1*7 02/15/2002
- +22 ;Q:"ASORHT"'[$P(^AUPNVSIT(AUPNVSIT,0),U,7) "^4:INVALID SERVICE CATEGORY" ;add telephone per ANMC;IHS/ASDST/GTH AUPN*99.1*7 02/15/2002;IHS/SET/GTH AUPN*99.1*8 10/04/2002
- +23 ;add telephone per ANMC;IHS/ASDST/GTH AUPN*99.1*7 02/15/2002;IHS/SET/GTH AUPN*99.1*8 10/04/2002
- IF "ASORHTC"'[$PIECE(^AUPNVSIT(AUPNVSIT,0),U,7)
- QUIT "^4:INVALID SERVICE CATEGORY"
- +24 ;
- +25 ;if vcn already exists, add to count until a good one is found
- +26 ;S COUNT=$P(^AUPNPAT(DFN,0),U,37) ;last VCN
- +27 ;F S COUNT=COUNT+1 Q:COUNT>99999 Q:'$D(^AUPNVSIT("VCN",DFN_"."_COUNT))
- +28 SET COUNT=+$GET(^AUPNVSIT("AVCN",DFN))
- +29 SET ALPHA=$$ALPHA(AUPNVSIT)
- IF ALPHA=""
- QUIT "^7:NO PSEUDO PREFIX FOR SITE"
- +30 IF ALPHA=+ALPHA
- QUIT "^8:INVALID PSEUDO PREFIX FOR SITE"
- +31 FOR
- SET COUNT=COUNT+1
- IF '$DATA(^AUPNVSIT("VCN",DFN_"."_COUNT_ALPHA))
- QUIT
- +32 IF COUNT>99999
- QUIT "^5:LAST VCN INVALID"
- +33 SET AUPNVCN=DFN_"."_COUNT_ALPHA
- +34 ;
- +35 SET DIE="^AUPNVSIT("
- SET DA=AUPNVSIT
- SET DR="1103///"_AUPNVCN
- DO ^DIE
- +36 IF $PIECE($GET(^AUPNVSIT(AUPNVSIT,11)),U,3)'=AUPNVCN
- QUIT "^6:DIE CALL FAILED:"_AUPNVCN
- +37 QUIT AUPNVCN
- +38 ;
- ALPHA(VISIT) ; - returns 3rd character of pseudo prefix form encounter location
- +1 NEW X
- +2 SET X=$PIECE($GET(^AUPNVSIT(+$GET(VISIT),0)),U,6)
- IF 'X
- QUIT ""
- +3 QUIT $EXTRACT($PIECE($GET(^AUTTLOC(X,1)),U,2),3)
- +4 ;
- +5 ;begin new code IHS/ASDST/GTH AUPN*99.1*7 02/15/2002
- UID(VISIT) ;EP - generate unique ID for visit
- +1 IF '$GET(VISIT)
- QUIT VISIT
- +2 NEW X
- +3 IF '$PIECE($GET(^AUTTSITE(1,1)),"^",3)
- SET $PIECE(^AUTTSITE(1,1),"^",3)=$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),"^",1),0),"^",10)
- +4 SET X=$PIECE(^AUTTSITE(1,1),"^",3)
- +5 QUIT X_$$LZERO(VISIT,10)
- +6 ;
- LZERO(V,L) ;EP - left zero fill
- +1 NEW %,I
- +2 SET %=$LENGTH(V)
- SET Z=L-%
- FOR I=1:1:Z
- SET V="0"_V
- +3 QUIT V
- +4 ;end new code IHS/ASDST/GTH AUPN*99.1*7 02/15/2002
- +5 ;
- INACLOC(Y) ;EP - return 1 if inactive, 0 if active
- +1 IF $GET(Y)=""
- QUIT 1
- +2 ;check to see if location of encounter is inactive based on visit date
- +3 NEW X
- +4 SET X=$$CHKLOC(Y)
- +5 IF $DATA(^AUTTLOC(Y))
- +6 QUIT X
- CHKLOC(Y) ; SCREEN OUT E CODES AND INACTIVE CODES
- +1 IF $DATA(DIFGLINE)
- QUIT 0
- +2 IF $DATA(ACHSDIEN)
- QUIT 0
- +3 IF $GET(DUZ("AG"))'="I"
- QUIT 0
- +4 NEW A,I,D
- +5 ;inactive date
- SET I=$PIECE(^AUTTLOC(Y,0),U,21)
- +6 SET D=""
- IF $GET(APCDVSIT)
- IF $DATA(^AUPNVSIT(APCDVSIT))
- SET D=$PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")
- +7 ;check date if have date
- +8 ;have date, date after inactive date
- IF $GET(APCDDATE)
- IF I]""
- IF APCDDATE>I
- QUIT 1
- +9 IF D]""
- IF I]""
- IF D>I
- QUIT 1
- +10 ;if have no date to check then check 21st piece
- +11 IF '$GET(APCDVSIT)
- IF '$GET(APCDDATE)
- IF $PIECE(^AUTTLOC(Y,0),U,21)
- QUIT 1
- +12 QUIT 0
- +13 ;
- A08 ;EP - for BTS per Christy Smith, Daou 5/12/05
- +1 IF '$GET(AUPNVSIT)
- QUIT
- +2 SET AUPNHLER=$$A08^BTSEVENT(AUPNVSIT)
- +3 KILL AUPNHLER
- +4 QUIT
- +5 ;
- MFI(Y) ;EP - called to determine whether a visit is an MFI visit
- +1 IF 'Y
- QUIT ""
- +2 IF '$DATA(^AUPNVSIT(Y))
- QUIT ""
- +3 IF $DATA(DIFGLINE)
- QUIT 1
- +4 IF $PIECE($GET(^AUPNVSIT(Y,11)),U,13)
- QUIT 1
- +5 IF $PIECE($GET(^AUPNVSIT(Y,0)),U,23)=.5
- QUIT 1
- +6 QUIT ""
- +7 ;
- UIDV(VISIT) ;EP - generate unique ID for visit
- +1 IF '$GET(VISIT)
- QUIT VISIT
- +2 NEW X
- +3 ;I '$P($G(^AUTTSITE(1,1)),"^",3) S $P(^AUTTSITE(1,1),"^",3)=$P(^AUTTLOC($P(^AUTTSITE(1,0),"^",1),0),"^",10)
- +4 SET X=$$GET1^DIQ(9999999.06,$PIECE(^AUTTSITE(1,0),U),.32)
- +5 IF X=""
- SET X="00000"
- +6 QUIT X_$$LZERO(VISIT,10)