BKMVIST4 ;PRXM/HC/JGH - Save 90459 data to V-Files and 90451.1 ; 07 Jun 2005 5:31 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
;PRXM/HC/BHS - 04/12/2006 - Removed HMS* tags related to File 90451.1
; which was removed September 2005 as v-file data
; is always filed to PCC rather than in HMS as well.
;
; Update PCC, V-Files, Visit File, using HMS
Q
;
HF(DFN,VISIT,DATABASE) ; EP - File Health Factor Visit data from File 90459
; Input variables:
; DFN - IEN for Patient
; VISIT - Visit ID
; DATABASE - 'PCC'
; Output variables: n/a
; Initialize
N HFVALUE,HFDATE,HFDT,HFTYPE,HFCAT,ERFLAG,DA,DA0,DA1,IENS,APCDADD,VISITDT,BKMTMP
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; HF subfiles
S HFDT=""
F S HFDT=$O(^BKM(90459,DA1,18,"B",HFDT)) Q:HFDT="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,18,"B",HFDT,DA0)) Q:DA0="" D
. . S DA=DA0,DA(1)=DA1
. . S IENS=$$IENS^DILF(.DA)
. . S HFVALUE=""
. . S HFDATE=HFDT
. . S HFTYPE=$$GET1^DIQ(90459.1818,IENS,.02,"I")
. . Q:HFTYPE=""
. . S HFCAT=$$GET1^DIQ(9999999.64,HFTYPE_",",.03,"I")
. . Q:HFCAT=""
. . ; Add V-File entry
. . S VISITDT=$P(HFDATE,".",1)
. . S VISIT=$G(^TMP("BKMVIST4 DATES",$J,VISITDT))
. . ; Create PCC Visit
. . I VISIT="" S APCDADD=1,(^TMP("BKMVIST4 DATES",$J,VISITDT),VISIT)=$$CRVISIT3(VISITDT,DFN)
. . I VISIT="" W !,"Unable to create PCC Visit!" S BKMTMP=$$PAUSE^BKMIXX3() Q
. . ; File PCC Health Factor V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2("HF",DFN,VISIT,HFTYPE,HFVALUE,HFDATE,"[APCDALVR 9000010.23 (ADD)]") ;,ERFLAG=$$REVEDHF(DFN,HFCAT,HFTYPE)
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELHF ; EP - Delete 90459.1818 HF subfiles
; Input variables: n/a
; Output variables: n/a
; Initialize
N DA,DA1,DA0,DIK,HF
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; HF subfiles
S HF=""
F S HF=$O(^BKM(90459,DA1,18,"B",HF)) Q:HF="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,18,"B",HF,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",18,"
. . D ^DIK
Q
;
EDUC(DFN,VISIT,DATABASE) ; EP - File Elder Visit data from File 90459
; Input variables:
; DFN - IEN for Patient
; VISIT - Visit ID
; DATABASE - 'PCC'
; Initialize
N DA1,DA0,EDU,EDUDATE,EDUTYPE,X,G,ERFLAG,APCDADD,EDUDT,VISITDT
N EDULOU,EDUOBJ,EDUTIG,EDUMIN,EDUTBC,EIENS,DA,BKMTMP,EDUPRO
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Education subfiles
S EDUDT=""
F S EDUDT=$O(^BKM(90459,DA1,12,"B",EDUDT)) Q:EDUDT="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,12,"B",EDUDT,DA0)) Q:DA0="" D
. . S DA=DA0,DA(1)=DA1
. . S EIENS=$$IENS^DILF(.DA)
. . S EDUDATE=EDUDT
. . S EDUTYPE=$$GET1^DIQ(90459.1212,EIENS,.02,"I")
. . Q:EDUTYPE?." "
. . S EDULOU=$$GET1^DIQ(90459.1212,EIENS,.03,"I")
. . S EDUPRO=$$GET1^DIQ(90459.1212,EIENS,.04,"I")
. . S EDUOBJ=$$GET1^DIQ(90459.1212,EIENS,.05,"I")
. . S EDUTIG=$$GET1^DIQ(90459.1212,EIENS,.06,"I")
. . S EDUMIN=$$GET1^DIQ(90459.1212,EIENS,.07,"I")
. . S EDUTBC=$$GET1^DIQ(90459.1212,EIENS,.08,"I")
. . ; Add V-File entry
. . S VISITDT=$P(EDUDATE,".",1)
. . S VISIT=$G(^TMP("BKMVIST4 DATES",$J,VISITDT))
. . ; Create PCC Visit
. . I VISIT="" S APCDADD=1,(^TMP("BKMVIST4 DATES",$J,VISITDT),VISIT)=$$CRVISIT3(VISITDT,DFN)
. . I VISIT="" W !,"Unable to create PCC Visit!" S BKMTMP=$$PAUSE^BKMIXX3() Q
. . ; File PCC Patient Education V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2("EDUC",DFN,VISIT,EDUTYPE,EIENS,EDUDATE,"[APCDALVR 9000010.16 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELEDUC ; EP - Delete 90459.1212 Education subfiles
; Input variables: n/a
; Output variables: n/a
; Initialize
N DA,DA1,DA0,DIK,EDU
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Education subfiles
S EDU=""
F S EDU=$O(^BKM(90459,DA1,12,"B",EDU)) Q:EDU="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,12,"B",EDU,DA0)) Q:DA0="" D
. . K DA
. . ; Delete subfile
. . S DA(1)=DA1,DA=DA0
. . S DIK="^BKM(90459,"_DA(1)_",12,"
. . D ^DIK
Q
;
CRVISIT3(EDATE,PATIENT) ; EP - Create File 9000010 entry
; Extrinsic function returns Visit (File 9000010) IEN or "", if error
; Assumes DUZ(2) and DT
; Input variables:
; DATE - Event date/time
; PATIENT - IEN for Patient
; Output variables: n/a
; Initialize
K APCDALVR
N BKMVSIT
S BKMVSIT=""
; Input variables
S APCDALVR("APCDADD")="" ; Force new visit
S APCDALVR("AUPNTALK")="" ; Non-interactive
S APCDALVR("APCDANE")="" ; No echo to screen
; Data fields
S APCDALVR("APCDDATE")=EDATE ; Internal event date/time
S APCDALVR("APCDTYPE")=$$GET1^DIQ(9001000,DUZ(2)_",",.04,"I") ; Type of visit
S APCDALVR("APCDPAT")=PATIENT ; Patients DFN
S APCDALVR("APCDLOC")=DUZ(2) ; Site Location
S APCDALVR("APCDCAT")="E" ; Event (historical)
; Create visit
D EN^APCDALV
; Check for error
I '$G(APCDALVR("APCDAFLG")) S BKMVSIT=$G(APCDALVR("APCDVSIT"))
; Cleanup
K APCDALVR
; Return with Visit ID or null if error
Q BKMVSIT
;
CRVFILE2(VFILE,PATIENT,VISIT,TYPE,VALUE,CRVDATE,TEMPLATE) ; EP - Create Visit-related file (V files)
; Input variables:
; VFILE - Visit related file type ex., HF, MED, etc.
; PATIENT - IEN for Patient
; VISIT - Visit ID
; TYPE - Type to add to the APCDALVR array
; VALUE - Value to add to the APCDALVR array or IENS to identify value
; CRVDATE - Event date/time
; TEMPLATE - Template name
; Output variables: n/a
; Returns V-File IEN or "" (if error)
; Initialize
K APCDALVR
N BKMVFIL
S BKMVFIL=""
;
; All the same
S APCDALVR("APCDPAT")=PATIENT
S APCDALVR("APCDVSIT")=VISIT
S APCDALVR("APCDATMP")=TEMPLATE
S APCDALVR("APCDTCDT")=CRVDATE
;
; Build APCDALVR array
I VFILE="MSR" D
. S APCDALVR("APCDTTYP")="`"_TYPE
. S APCDALVR("APCDTVAL")=VALUE
ELSE I VFILE="PRC" D
. S APCDALVR("APCDTPRC")="`"_TYPE
. S APCDALVR("APCDTNQ")=VALUE
. S APCDALVR("APCDTPD")=CRVDATE\1
ELSE I VFILE="LAB" D
. S APCDALVR("APCDTLAB")="`"_TYPE
. S APCDALVR("APCDTRES")=$$GET1^DIQ(90459.1313,VALUE,.03,"I")
. S APCDALVR("APCDTUNI")=$$GET1^DIQ(90459.1313,VALUE,1101,"I")
. S APCDALVR("APCDTRFL")=$$GET1^DIQ(90459.1313,VALUE,1104,"I")
. S APCDALVR("APCDTRFH")=$$GET1^DIQ(90459.1313,VALUE,1105,"I")
ELSE I VFILE="IMMUN" D
. S APCDALVR("APCDTIMM")="`"_TYPE
. S APCDALVR("APCDTSER")=$$GET1^DIQ(90459.2323,VALUE,.04,"I")
. S APCDALVR("APCDTLOT")=$$GET1^DIQ(90459.2323,VALUE,.05,"I")
. S APCDALVR("APCDTREC")=$$GET1^DIQ(90459.2323,VALUE,.06,"I")
ELSE I VFILE="SKIN" D
. S APCDALVR("APCDTSK")="`"_TYPE
. S APCDALVR("APCDTRES")=$$GET1^DIQ(90459.2222,VALUE,.04,"I")
. S APCDALVR("APCDTREA")=$$GET1^DIQ(90459.2222,VALUE,.05,"I")
. ;S APCDALVR("APCDTEPR")=$$GET1^DIQ(90459.2222,VALUE,.08,"I")
ELSE I VFILE="MED" D
. S APCDALVR("APCDTRX")="`"_TYPE
. S APCDALVR("APCDTSIG")=$$GET1^DIQ(90459.1414,VALUE,.04,"I")
. S APCDALVR("APCDTQTY")=$$GET1^DIQ(90459.1414,VALUE,.03,"I")
. S APCDALVR("APCDTDAY")=$$GET1^DIQ(90459.1414,VALUE,.07,"I")
ELSE I VFILE="RAD" D
. S APCDALVR("APCDTRAD")="`"_TYPE
. S APCDALVR("APCDTABN")=VALUE
ELSE I VFILE="XAM" D
. S APCDALVR("APCDTEX")="`"_TYPE
. S APCDALVR("APCDTRES")=VALUE
ELSE I VFILE="EDUC" D
. S APCDALVR("APCDTTOP")="`"_TYPE
. S EDUPRO=$$GET1^DIQ(90459.1212,VALUE,.04,"I")
. S APCDALVR("APCDTPRO")=$S(EDUPRO'="":"`"_EDUPRO,1:"")
. S APCDALVR("APCDTLOU")=$$GET1^DIQ(90459.1212,VALUE,.03,"I")
. S APCDALVR("APCDTIG")=$$GET1^DIQ(90459.1212,VALUE,.06,"I")
. S APCDALVR("APCDTMIN")=$$GET1^DIQ(90459.1212,VALUE,.07,"I")
. S APCDALVR("APCDTBC")=$$GET1^DIQ(90459.1212,VALUE,.08,"I")
. S APCDALVR("APCDTOBJ")=$$GET1^DIQ(90459.1212,VALUE,.05,"I")
ELSE I VFILE="HF" D
. S APCDALVR("APCDTHF")="`"_TYPE
ELSE I VFILE="ELDER" D
. ; One Elder Care form per visit
. S APCDALVR("APCDTTYP")=VISIT
. S APCDALVR("FORMID")=TYPE
. S APCDALVR("TOILET")=$$GET1^DIQ(90459.1616,VALUE,".04","I")
. S APCDALVR("BATH")=$$GET1^DIQ(90459.1616,VALUE,".05","I")
. S APCDALVR("DRESS")=$$GET1^DIQ(90459.1616,VALUE,".06","I")
. S APCDALVR("TRANSFER")=$$GET1^DIQ(90459.1616,VALUE,".07","I")
. S APCDALVR("FEED")=$$GET1^DIQ(90459.1616,VALUE,".08","I")
. S APCDALVR("CONTINEN")=$$GET1^DIQ(90459.1616,VALUE,".09","I")
. S APCDALVR("FINANCES")=$$GET1^DIQ(90459.1616,VALUE,".11","I")
. S APCDALVR("COOK")=$$GET1^DIQ(90459.1616,VALUE,".12","I")
. S APCDALVR("SHOP")=$$GET1^DIQ(90459.1616,VALUE,".13","I")
. S APCDALVR("HOUSEWK")=$$GET1^DIQ(90459.1616,VALUE,".14","I")
. S APCDALVR("MEDICAT")=$$GET1^DIQ(90459.1616,VALUE,".15","I")
. S APCDALVR("TRANSP")=$$GET1^DIQ(90459.1616,VALUE,".16","I")
. S APCDALVR("CHFUNC")=$$GET1^DIQ(90459.1616,VALUE,".17","I")
. S APCDALVR("CAREGVR")=$$GET1^DIQ(90459.1616,VALUE,".18","I")
. S APCDALVR("OPROV")=$$GET1^DIQ(90459.1616,VALUE,"1202","I")
. S APCDALVR("CLINIC")=$$GET1^DIQ(90459.1616,VALUE,"1203","I")
. S APCDALVR("EPROV")=$$GET1^DIQ(90459.1616,VALUE,"1204","I")
. S APCDALVR("EXKEY")=$$GET1^DIQ(90459.1616,VALUE,"1209","I")
. S APCDALVR("OPNAME")=$$GET1^DIQ(90459.1616,VALUE,"1210","I")
; Create V files
D EN^APCDALVR
; Check for error
I '$G(APCDALVR("APCDAFLG")) S BKMVFIL=$G(APCDALVR("APCDADFN"))
; Cleanup
K APCDALVR
; Return with Visit ID or null if error
Q BKMVFIL
;
;
BKMVIST4 ;PRXM/HC/JGH - Save 90459 data to V-Files and 90451.1 ; 07 Jun 2005 5:31 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ;PRXM/HC/BHS - 04/12/2006 - Removed HMS* tags related to File 90451.1
+4 ; which was removed September 2005 as v-file data
+5 ; is always filed to PCC rather than in HMS as well.
+6 ;
+7 ; Update PCC, V-Files, Visit File, using HMS
+8 QUIT
+9 ;
HF(DFN,VISIT,DATABASE) ; EP - File Health Factor Visit data from File 90459
+1 ; Input variables:
+2 ; DFN - IEN for Patient
+3 ; VISIT - Visit ID
+4 ; DATABASE - 'PCC'
+5 ; Output variables: n/a
+6 ; Initialize
+7 NEW HFVALUE,HFDATE,HFDT,HFTYPE,HFCAT,ERFLAG,DA,DA0,DA1,IENS,APCDADD,VISITDT,BKMTMP
+8 ; PCC Buffer IEN
+9 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+10 IF DA1=""
QUIT
+11 ; Init
+12 KILL ^TMP("BKMVIST4 DATES",$JOB)
+13 ; HF subfiles
+14 SET HFDT=""
+15 FOR
SET HFDT=$ORDER(^BKM(90459,DA1,18,"B",HFDT))
IF HFDT=""
QUIT
Begin DoDot:1
+16 SET DA0=""
+17 FOR
SET DA0=$ORDER(^BKM(90459,DA1,18,"B",HFDT,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+18 SET DA=DA0
SET DA(1)=DA1
+19 SET IENS=$$IENS^DILF(.DA)
+20 SET HFVALUE=""
+21 SET HFDATE=HFDT
+22 SET HFTYPE=$$GET1^DIQ(90459.1818,IENS,.02,"I")
+23 IF HFTYPE=""
QUIT
+24 SET HFCAT=$$GET1^DIQ(9999999.64,HFTYPE_",",.03,"I")
+25 IF HFCAT=""
QUIT
+26 ; Add V-File entry
+27 SET VISITDT=$PIECE(HFDATE,".",1)
+28 SET VISIT=$GET(^TMP("BKMVIST4 DATES",$JOB,VISITDT))
+29 ; Create PCC Visit
+30 IF VISIT=""
SET APCDADD=1
SET (^TMP("BKMVIST4 DATES",$JOB,VISITDT),VISIT)=$$CRVISIT3(VISITDT,DFN)
+31 IF VISIT=""
WRITE !,"Unable to create PCC Visit!"
SET BKMTMP=$$PAUSE^BKMIXX3()
QUIT
+32 ; File PCC Health Factor V-File entry
+33 ;,ERFLAG=$$REVEDHF(DFN,HFCAT,HFTYPE)
IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2("HF",DFN,VISIT,HFTYPE,HFVALUE,HFDATE,"[APCDALVR 9000010.23 (ADD)]")
+34 IF ERFLAG=""
WRITE !,"Unable to create V-File entry!"
SET BKMTMP=$$PAUSE^BKMIXX3()
End DoDot:2
End DoDot:1
+35 KILL ^TMP("BKMVIST4 DATES",$JOB)
+36 QUIT
+37 ;
DELHF ; EP - Delete 90459.1818 HF subfiles
+1 ; Input variables: n/a
+2 ; Output variables: n/a
+3 ; Initialize
+4 NEW DA,DA1,DA0,DIK,HF
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; HF subfiles
+9 SET HF=""
+10 FOR
SET HF=$ORDER(^BKM(90459,DA1,18,"B",HF))
IF HF=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,18,"B",HF,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+13 KILL DA
+14 SET DA(1)=DA1
SET DA=DA0
+15 ; Delete subfile
+16 SET DIK="^BKM(90459,"_DA(1)_",18,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
EDUC(DFN,VISIT,DATABASE) ; EP - File Elder Visit data from File 90459
+1 ; Input variables:
+2 ; DFN - IEN for Patient
+3 ; VISIT - Visit ID
+4 ; DATABASE - 'PCC'
+5 ; Initialize
+6 NEW DA1,DA0,EDU,EDUDATE,EDUTYPE,X,G,ERFLAG,APCDADD,EDUDT,VISITDT
+7 NEW EDULOU,EDUOBJ,EDUTIG,EDUMIN,EDUTBC,EIENS,DA,BKMTMP,EDUPRO
+8 ; PCC Buffer IEN
+9 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+10 IF DA1=""
QUIT
+11 ; Init
+12 KILL ^TMP("BKMVIST4 DATES",$JOB)
+13 ; Education subfiles
+14 SET EDUDT=""
+15 FOR
SET EDUDT=$ORDER(^BKM(90459,DA1,12,"B",EDUDT))
IF EDUDT=""
QUIT
Begin DoDot:1
+16 SET DA0=""
+17 FOR
SET DA0=$ORDER(^BKM(90459,DA1,12,"B",EDUDT,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+18 SET DA=DA0
SET DA(1)=DA1
+19 SET EIENS=$$IENS^DILF(.DA)
+20 SET EDUDATE=EDUDT
+21 SET EDUTYPE=$$GET1^DIQ(90459.1212,EIENS,.02,"I")
+22 IF EDUTYPE?." "
QUIT
+23 SET EDULOU=$$GET1^DIQ(90459.1212,EIENS,.03,"I")
+24 SET EDUPRO=$$GET1^DIQ(90459.1212,EIENS,.04,"I")
+25 SET EDUOBJ=$$GET1^DIQ(90459.1212,EIENS,.05,"I")
+26 SET EDUTIG=$$GET1^DIQ(90459.1212,EIENS,.06,"I")
+27 SET EDUMIN=$$GET1^DIQ(90459.1212,EIENS,.07,"I")
+28 SET EDUTBC=$$GET1^DIQ(90459.1212,EIENS,.08,"I")
+29 ; Add V-File entry
+30 SET VISITDT=$PIECE(EDUDATE,".",1)
+31 SET VISIT=$GET(^TMP("BKMVIST4 DATES",$JOB,VISITDT))
+32 ; Create PCC Visit
+33 IF VISIT=""
SET APCDADD=1
SET (^TMP("BKMVIST4 DATES",$JOB,VISITDT),VISIT)=$$CRVISIT3(VISITDT,DFN)
+34 IF VISIT=""
WRITE !,"Unable to create PCC Visit!"
SET BKMTMP=$$PAUSE^BKMIXX3()
QUIT
+35 ; File PCC Patient Education V-File entry
+36 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2("EDUC",DFN,VISIT,EDUTYPE,EIENS,EDUDATE,"[APCDALVR 9000010.16 (ADD)]")
+37 IF ERFLAG=""
WRITE !,"Unable to create V-File entry!"
SET BKMTMP=$$PAUSE^BKMIXX3()
End DoDot:2
End DoDot:1
+38 KILL ^TMP("BKMVIST4 DATES",$JOB)
+39 QUIT
+40 ;
DELEDUC ; EP - Delete 90459.1212 Education subfiles
+1 ; Input variables: n/a
+2 ; Output variables: n/a
+3 ; Initialize
+4 NEW DA,DA1,DA0,DIK,EDU
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; Education subfiles
+9 SET EDU=""
+10 FOR
SET EDU=$ORDER(^BKM(90459,DA1,12,"B",EDU))
IF EDU=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,12,"B",EDU,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+13 KILL DA
+14 ; Delete subfile
+15 SET DA(1)=DA1
SET DA=DA0
+16 SET DIK="^BKM(90459,"_DA(1)_",12,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
CRVISIT3(EDATE,PATIENT) ; EP - Create File 9000010 entry
+1 ; Extrinsic function returns Visit (File 9000010) IEN or "", if error
+2 ; Assumes DUZ(2) and DT
+3 ; Input variables:
+4 ; DATE - Event date/time
+5 ; PATIENT - IEN for Patient
+6 ; Output variables: n/a
+7 ; Initialize
+8 KILL APCDALVR
+9 NEW BKMVSIT
+10 SET BKMVSIT=""
+11 ; Input variables
+12 ; Force new visit
SET APCDALVR("APCDADD")=""
+13 ; Non-interactive
SET APCDALVR("AUPNTALK")=""
+14 ; No echo to screen
SET APCDALVR("APCDANE")=""
+15 ; Data fields
+16 ; Internal event date/time
SET APCDALVR("APCDDATE")=EDATE
+17 ; Type of visit
SET APCDALVR("APCDTYPE")=$$GET1^DIQ(9001000,DUZ(2)_",",.04,"I")
+18 ; Patients DFN
SET APCDALVR("APCDPAT")=PATIENT
+19 ; Site Location
SET APCDALVR("APCDLOC")=DUZ(2)
+20 ; Event (historical)
SET APCDALVR("APCDCAT")="E"
+21 ; Create visit
+22 DO EN^APCDALV
+23 ; Check for error
+24 IF '$GET(APCDALVR("APCDAFLG"))
SET BKMVSIT=$GET(APCDALVR("APCDVSIT"))
+25 ; Cleanup
+26 KILL APCDALVR
+27 ; Return with Visit ID or null if error
+28 QUIT BKMVSIT
+29 ;
CRVFILE2(VFILE,PATIENT,VISIT,TYPE,VALUE,CRVDATE,TEMPLATE) ; EP - Create Visit-related file (V files)
+1 ; Input variables:
+2 ; VFILE - Visit related file type ex., HF, MED, etc.
+3 ; PATIENT - IEN for Patient
+4 ; VISIT - Visit ID
+5 ; TYPE - Type to add to the APCDALVR array
+6 ; VALUE - Value to add to the APCDALVR array or IENS to identify value
+7 ; CRVDATE - Event date/time
+8 ; TEMPLATE - Template name
+9 ; Output variables: n/a
+10 ; Returns V-File IEN or "" (if error)
+11 ; Initialize
+12 KILL APCDALVR
+13 NEW BKMVFIL
+14 SET BKMVFIL=""
+15 ;
+16 ; All the same
+17 SET APCDALVR("APCDPAT")=PATIENT
+18 SET APCDALVR("APCDVSIT")=VISIT
+19 SET APCDALVR("APCDATMP")=TEMPLATE
+20 SET APCDALVR("APCDTCDT")=CRVDATE
+21 ;
+22 ; Build APCDALVR array
+23 IF VFILE="MSR"
Begin DoDot:1
+24 SET APCDALVR("APCDTTYP")="`"_TYPE
+25 SET APCDALVR("APCDTVAL")=VALUE
End DoDot:1
+26 IF '$TEST
IF VFILE="PRC"
Begin DoDot:1
+27 SET APCDALVR("APCDTPRC")="`"_TYPE
+28 SET APCDALVR("APCDTNQ")=VALUE
+29 SET APCDALVR("APCDTPD")=CRVDATE\1
End DoDot:1
+30 IF '$TEST
IF VFILE="LAB"
Begin DoDot:1
+31 SET APCDALVR("APCDTLAB")="`"_TYPE
+32 SET APCDALVR("APCDTRES")=$$GET1^DIQ(90459.1313,VALUE,.03,"I")
+33 SET APCDALVR("APCDTUNI")=$$GET1^DIQ(90459.1313,VALUE,1101,"I")
+34 SET APCDALVR("APCDTRFL")=$$GET1^DIQ(90459.1313,VALUE,1104,"I")
+35 SET APCDALVR("APCDTRFH")=$$GET1^DIQ(90459.1313,VALUE,1105,"I")
End DoDot:1
+36 IF '$TEST
IF VFILE="IMMUN"
Begin DoDot:1
+37 SET APCDALVR("APCDTIMM")="`"_TYPE
+38 SET APCDALVR("APCDTSER")=$$GET1^DIQ(90459.2323,VALUE,.04,"I")
+39 SET APCDALVR("APCDTLOT")=$$GET1^DIQ(90459.2323,VALUE,.05,"I")
+40 SET APCDALVR("APCDTREC")=$$GET1^DIQ(90459.2323,VALUE,.06,"I")
End DoDot:1
+41 IF '$TEST
IF VFILE="SKIN"
Begin DoDot:1
+42 SET APCDALVR("APCDTSK")="`"_TYPE
+43 SET APCDALVR("APCDTRES")=$$GET1^DIQ(90459.2222,VALUE,.04,"I")
+44 SET APCDALVR("APCDTREA")=$$GET1^DIQ(90459.2222,VALUE,.05,"I")
+45 ;S APCDALVR("APCDTEPR")=$$GET1^DIQ(90459.2222,VALUE,.08,"I")
End DoDot:1
+46 IF '$TEST
IF VFILE="MED"
Begin DoDot:1
+47 SET APCDALVR("APCDTRX")="`"_TYPE
+48 SET APCDALVR("APCDTSIG")=$$GET1^DIQ(90459.1414,VALUE,.04,"I")
+49 SET APCDALVR("APCDTQTY")=$$GET1^DIQ(90459.1414,VALUE,.03,"I")
+50 SET APCDALVR("APCDTDAY")=$$GET1^DIQ(90459.1414,VALUE,.07,"I")
End DoDot:1
+51 IF '$TEST
IF VFILE="RAD"
Begin DoDot:1
+52 SET APCDALVR("APCDTRAD")="`"_TYPE
+53 SET APCDALVR("APCDTABN")=VALUE
End DoDot:1
+54 IF '$TEST
IF VFILE="XAM"
Begin DoDot:1
+55 SET APCDALVR("APCDTEX")="`"_TYPE
+56 SET APCDALVR("APCDTRES")=VALUE
End DoDot:1
+57 IF '$TEST
IF VFILE="EDUC"
Begin DoDot:1
+58 SET APCDALVR("APCDTTOP")="`"_TYPE
+59 SET EDUPRO=$$GET1^DIQ(90459.1212,VALUE,.04,"I")
+60 SET APCDALVR("APCDTPRO")=$SELECT(EDUPRO'="":"`"_EDUPRO,1:"")
+61 SET APCDALVR("APCDTLOU")=$$GET1^DIQ(90459.1212,VALUE,.03,"I")
+62 SET APCDALVR("APCDTIG")=$$GET1^DIQ(90459.1212,VALUE,.06,"I")
+63 SET APCDALVR("APCDTMIN")=$$GET1^DIQ(90459.1212,VALUE,.07,"I")
+64 SET APCDALVR("APCDTBC")=$$GET1^DIQ(90459.1212,VALUE,.08,"I")
+65 SET APCDALVR("APCDTOBJ")=$$GET1^DIQ(90459.1212,VALUE,.05,"I")
End DoDot:1
+66 IF '$TEST
IF VFILE="HF"
Begin DoDot:1
+67 SET APCDALVR("APCDTHF")="`"_TYPE
End DoDot:1
+68 IF '$TEST
IF VFILE="ELDER"
Begin DoDot:1
+69 ; One Elder Care form per visit
+70 SET APCDALVR("APCDTTYP")=VISIT
+71 SET APCDALVR("FORMID")=TYPE
+72 SET APCDALVR("TOILET")=$$GET1^DIQ(90459.1616,VALUE,".04","I")
+73 SET APCDALVR("BATH")=$$GET1^DIQ(90459.1616,VALUE,".05","I")
+74 SET APCDALVR("DRESS")=$$GET1^DIQ(90459.1616,VALUE,".06","I")
+75 SET APCDALVR("TRANSFER")=$$GET1^DIQ(90459.1616,VALUE,".07","I")
+76 SET APCDALVR("FEED")=$$GET1^DIQ(90459.1616,VALUE,".08","I")
+77 SET APCDALVR("CONTINEN")=$$GET1^DIQ(90459.1616,VALUE,".09","I")
+78 SET APCDALVR("FINANCES")=$$GET1^DIQ(90459.1616,VALUE,".11","I")
+79 SET APCDALVR("COOK")=$$GET1^DIQ(90459.1616,VALUE,".12","I")
+80 SET APCDALVR("SHOP")=$$GET1^DIQ(90459.1616,VALUE,".13","I")
+81 SET APCDALVR("HOUSEWK")=$$GET1^DIQ(90459.1616,VALUE,".14","I")
+82 SET APCDALVR("MEDICAT")=$$GET1^DIQ(90459.1616,VALUE,".15","I")
+83 SET APCDALVR("TRANSP")=$$GET1^DIQ(90459.1616,VALUE,".16","I")
+84 SET APCDALVR("CHFUNC")=$$GET1^DIQ(90459.1616,VALUE,".17","I")
+85 SET APCDALVR("CAREGVR")=$$GET1^DIQ(90459.1616,VALUE,".18","I")
+86 SET APCDALVR("OPROV")=$$GET1^DIQ(90459.1616,VALUE,"1202","I")
+87 SET APCDALVR("CLINIC")=$$GET1^DIQ(90459.1616,VALUE,"1203","I")
+88 SET APCDALVR("EPROV")=$$GET1^DIQ(90459.1616,VALUE,"1204","I")
+89 SET APCDALVR("EXKEY")=$$GET1^DIQ(90459.1616,VALUE,"1209","I")
+90 SET APCDALVR("OPNAME")=$$GET1^DIQ(90459.1616,VALUE,"1210","I")
End DoDot:1
+91 ; Create V files
+92 DO EN^APCDALVR
+93 ; Check for error
+94 IF '$GET(APCDALVR("APCDAFLG"))
SET BKMVFIL=$GET(APCDALVR("APCDADFN"))
+95 ; Cleanup
+96 KILL APCDALVR
+97 ; Return with Visit ID or null if error
+98 QUIT BKMVFIL
+99 ;
+100 ;
