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

BKMVIST4.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;PRXM/HC/BHS - 04/12/2006 - Removed HMS* tags related to File 90451.1
  1.  ;                            which was removed September 2005 as v-file data
  1.  ;                            is always filed to PCC rather than in HMS as well.
  1.  ;                            
  1.  ; Update PCC, V-Files, Visit File, using HMS
  1.  Q
  1.  ;
  1. HF(DFN,VISIT,DATABASE) ; EP - File Health Factor Visit data from File 90459
  1.  ; Input variables:
  1.  ;  DFN - IEN for Patient
  1.  ;  VISIT - Visit ID
  1.  ;  DATABASE - 'PCC'
  1.  ; Output variables: n/a
  1.  ; Initialize
  1.  N HFVALUE,HFDATE,HFDT,HFTYPE,HFCAT,ERFLAG,DA,DA0,DA1,IENS,APCDADD,VISITDT,BKMTMP
  1.  ; PCC Buffer IEN
  1.  S DA1=$O(^BKM(90459,"B",$J,""))
  1.  Q:DA1=""
  1.  ; Init
  1.  K ^TMP("BKMVIST4 DATES",$J)
  1.  ; HF subfiles
  1.  S HFDT=""
  1.  F  S HFDT=$O(^BKM(90459,DA1,18,"B",HFDT)) Q:HFDT=""  D
  1.  . S DA0=""
  1.  . F  S DA0=$O(^BKM(90459,DA1,18,"B",HFDT,DA0)) Q:DA0=""  D
  1.  . . S DA=DA0,DA(1)=DA1
  1.  . . S IENS=$$IENS^DILF(.DA)
  1.  . . S HFVALUE=""
  1.  . . S HFDATE=HFDT
  1.  . . S HFTYPE=$$GET1^DIQ(90459.1818,IENS,.02,"I")
  1.  . . Q:HFTYPE=""
  1.  . . S HFCAT=$$GET1^DIQ(9999999.64,HFTYPE_",",.03,"I")
  1.  . . Q:HFCAT=""
  1.  . . ; Add V-File entry
  1.  . . S VISITDT=$P(HFDATE,".",1)
  1.  . . S VISIT=$G(^TMP("BKMVIST4 DATES",$J,VISITDT))
  1.  . . ; Create PCC Visit
  1.  . . I VISIT="" S APCDADD=1,(^TMP("BKMVIST4 DATES",$J,VISITDT),VISIT)=$$CRVISIT3(VISITDT,DFN)
  1.  . . I VISIT="" W !,"Unable to create PCC Visit!" S BKMTMP=$$PAUSE^BKMIXX3() Q
  1.  . . ; File PCC Health Factor V-File entry
  1.  . . S:DATABASE="PCC" ERFLAG=$$CRVFILE2("HF",DFN,VISIT,HFTYPE,HFVALUE,HFDATE,"[APCDALVR 9000010.23 (ADD)]") ;,ERFLAG=$$REVEDHF(DFN,HFCAT,HFTYPE) 
  1.  . . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
  1.  K ^TMP("BKMVIST4 DATES",$J)
  1.  Q
  1.  ;
  1. DELHF ; EP - Delete 90459.1818 HF subfiles
  1.  ; Input variables:  n/a
  1.  ; Output variables: n/a
  1.  ; Initialize
  1.  N DA,DA1,DA0,DIK,HF
  1.  ; PCC Buffer IEN
  1.  S DA1=$O(^BKM(90459,"B",$J,""))
  1.  Q:DA1=""
  1.  ; HF subfiles
  1.  S HF=""
  1.  F  S HF=$O(^BKM(90459,DA1,18,"B",HF)) Q:HF=""  D
  1.  . S DA0=""
  1.  . F  S DA0=$O(^BKM(90459,DA1,18,"B",HF,DA0)) Q:DA0=""  D
  1.  . . K DA
  1.  . . S DA(1)=DA1,DA=DA0
  1.  . . ; Delete subfile
  1.  . . S DIK="^BKM(90459,"_DA(1)_",18,"
  1.  . . D ^DIK
  1.  Q
  1.  ;
  1. EDUC(DFN,VISIT,DATABASE)  ; EP - File Elder Visit data from File 90459
  1.  ; Input variables:
  1.  ;  DFN - IEN for Patient
  1.  ;  VISIT - Visit ID
  1.  ;  DATABASE - 'PCC'
  1.  ; Initialize
  1.  N DA1,DA0,EDU,EDUDATE,EDUTYPE,X,G,ERFLAG,APCDADD,EDUDT,VISITDT
  1.  N EDULOU,EDUOBJ,EDUTIG,EDUMIN,EDUTBC,EIENS,DA,BKMTMP,EDUPRO
  1.  ; PCC Buffer IEN
  1.  S DA1=$O(^BKM(90459,"B",$J,""))
  1.  Q:DA1=""
  1.  ; Init
  1.  K ^TMP("BKMVIST4 DATES",$J)
  1.  ; Education subfiles
  1.  S EDUDT=""
  1.  F  S EDUDT=$O(^BKM(90459,DA1,12,"B",EDUDT)) Q:EDUDT=""  D
  1.  . S DA0=""
  1.  . F  S DA0=$O(^BKM(90459,DA1,12,"B",EDUDT,DA0)) Q:DA0=""  D
  1.  . . S DA=DA0,DA(1)=DA1
  1.  . . S EIENS=$$IENS^DILF(.DA)
  1.  . . S EDUDATE=EDUDT
  1.  . . S EDUTYPE=$$GET1^DIQ(90459.1212,EIENS,.02,"I")
  1.  . . Q:EDUTYPE?." "
  1.  . . S EDULOU=$$GET1^DIQ(90459.1212,EIENS,.03,"I")
  1.  . . S EDUPRO=$$GET1^DIQ(90459.1212,EIENS,.04,"I")
  1.  . . S EDUOBJ=$$GET1^DIQ(90459.1212,EIENS,.05,"I")
  1.  . . S EDUTIG=$$GET1^DIQ(90459.1212,EIENS,.06,"I")
  1.  . . S EDUMIN=$$GET1^DIQ(90459.1212,EIENS,.07,"I")
  1.  . . S EDUTBC=$$GET1^DIQ(90459.1212,EIENS,.08,"I")
  1.  . . ; Add V-File entry
  1.  . . S VISITDT=$P(EDUDATE,".",1)
  1.  . . S VISIT=$G(^TMP("BKMVIST4 DATES",$J,VISITDT))
  1.  . . ; Create PCC Visit
  1.  . . I VISIT="" S APCDADD=1,(^TMP("BKMVIST4 DATES",$J,VISITDT),VISIT)=$$CRVISIT3(VISITDT,DFN)
  1.  . . I VISIT="" W !,"Unable to create PCC Visit!" S BKMTMP=$$PAUSE^BKMIXX3() Q
  1.  . . ; File PCC Patient Education V-File entry
  1.  . . S:DATABASE="PCC" ERFLAG=$$CRVFILE2("EDUC",DFN,VISIT,EDUTYPE,EIENS,EDUDATE,"[APCDALVR 9000010.16 (ADD)]")
  1.  . . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
  1.  K ^TMP("BKMVIST4 DATES",$J)
  1.  Q
  1.  ;
  1. DELEDUC ; EP - Delete 90459.1212 Education subfiles
  1.  ; Input variables:  n/a
  1.  ; Output variables: n/a
  1.  ; Initialize
  1.  N DA,DA1,DA0,DIK,EDU
  1.  ; PCC Buffer IEN
  1.  S DA1=$O(^BKM(90459,"B",$J,""))
  1.  Q:DA1=""
  1.  ; Education subfiles
  1.  S EDU=""
  1.  F  S EDU=$O(^BKM(90459,DA1,12,"B",EDU)) Q:EDU=""  D
  1.  . S DA0=""
  1.  . F  S DA0=$O(^BKM(90459,DA1,12,"B",EDU,DA0)) Q:DA0=""  D
  1.  . . K DA
  1.  . . ; Delete subfile
  1.  . . S DA(1)=DA1,DA=DA0
  1.  . . S DIK="^BKM(90459,"_DA(1)_",12,"
  1.  . . D ^DIK
  1.  Q
  1.  ;
  1. CRVISIT3(EDATE,PATIENT) ; EP - Create File 9000010 entry
  1.  ; Extrinsic function returns Visit (File 9000010) IEN or "", if error
  1.  ; Assumes DUZ(2) and DT
  1.  ; Input variables:
  1.  ;  DATE - Event date/time
  1.  ;  PATIENT - IEN for Patient
  1.  ; Output variables: n/a
  1.  ; Initialize
  1.  K APCDALVR
  1.  N BKMVSIT
  1.  S BKMVSIT=""
  1.  ; Input variables
  1.  S APCDALVR("APCDADD")=""  ; Force new visit
  1.  S APCDALVR("AUPNTALK")="" ; Non-interactive
  1.  S APCDALVR("APCDANE")=""  ; No echo to screen
  1.  ; Data fields
  1.  S APCDALVR("APCDDATE")=EDATE  ; Internal event date/time
  1.  S APCDALVR("APCDTYPE")=$$GET1^DIQ(9001000,DUZ(2)_",",.04,"I") ; Type of visit
  1.  S APCDALVR("APCDPAT")=PATIENT ; Patients DFN
  1.  S APCDALVR("APCDLOC")=DUZ(2)  ; Site Location
  1.  S APCDALVR("APCDCAT")="E"     ; Event (historical)
  1.  ; Create visit
  1.  D EN^APCDALV
  1.  ; Check for error
  1.  I '$G(APCDALVR("APCDAFLG")) S BKMVSIT=$G(APCDALVR("APCDVSIT"))
  1.  ; Cleanup
  1.  K APCDALVR
  1.  ; Return with Visit ID or null if error
  1.  Q BKMVSIT
  1.  ;
  1. CRVFILE2(VFILE,PATIENT,VISIT,TYPE,VALUE,CRVDATE,TEMPLATE) ; EP - Create Visit-related file (V files)
  1.  ; Input variables:
  1.  ;  VFILE - Visit related file type ex., HF, MED, etc.
  1.  ;  PATIENT - IEN for Patient
  1.  ;  VISIT - Visit ID
  1.  ;  TYPE - Type to add to the APCDALVR array
  1.  ;  VALUE - Value to add to the APCDALVR array or IENS to identify value
  1.  ;  CRVDATE - Event date/time
  1.  ;  TEMPLATE - Template name
  1.  ; Output variables: n/a
  1.  ;  Returns V-File IEN or "" (if error)
  1.  ; Initialize
  1.  K APCDALVR
  1.  N BKMVFIL
  1.  S BKMVFIL=""
  1.  ;
  1.  ; All the same
  1.  S APCDALVR("APCDPAT")=PATIENT
  1.  S APCDALVR("APCDVSIT")=VISIT
  1.  S APCDALVR("APCDATMP")=TEMPLATE
  1.  S APCDALVR("APCDTCDT")=CRVDATE
  1.  ;
  1.  ; Build APCDALVR array
  1.  I VFILE="MSR" D
  1.  . S APCDALVR("APCDTTYP")="`"_TYPE
  1.  . S APCDALVR("APCDTVAL")=VALUE
  1.  ELSE  I VFILE="PRC" D
  1.  . S APCDALVR("APCDTPRC")="`"_TYPE
  1.  . S APCDALVR("APCDTNQ")=VALUE
  1.  . S APCDALVR("APCDTPD")=CRVDATE\1
  1.  ELSE  I VFILE="LAB" D
  1.  . S APCDALVR("APCDTLAB")="`"_TYPE
  1.  . S APCDALVR("APCDTRES")=$$GET1^DIQ(90459.1313,VALUE,.03,"I")
  1.  . S APCDALVR("APCDTUNI")=$$GET1^DIQ(90459.1313,VALUE,1101,"I")
  1.  . S APCDALVR("APCDTRFL")=$$GET1^DIQ(90459.1313,VALUE,1104,"I")
  1.  . S APCDALVR("APCDTRFH")=$$GET1^DIQ(90459.1313,VALUE,1105,"I")
  1.  ELSE  I VFILE="IMMUN" D
  1.  . S APCDALVR("APCDTIMM")="`"_TYPE
  1.  . S APCDALVR("APCDTSER")=$$GET1^DIQ(90459.2323,VALUE,.04,"I")
  1.  . S APCDALVR("APCDTLOT")=$$GET1^DIQ(90459.2323,VALUE,.05,"I")
  1.  . S APCDALVR("APCDTREC")=$$GET1^DIQ(90459.2323,VALUE,.06,"I")
  1.  ELSE  I VFILE="SKIN" D
  1.  . S APCDALVR("APCDTSK")="`"_TYPE
  1.  . S APCDALVR("APCDTRES")=$$GET1^DIQ(90459.2222,VALUE,.04,"I")
  1.  . S APCDALVR("APCDTREA")=$$GET1^DIQ(90459.2222,VALUE,.05,"I")
  1.  . ;S APCDALVR("APCDTEPR")=$$GET1^DIQ(90459.2222,VALUE,.08,"I")
  1.  ELSE  I VFILE="MED" D
  1.  . S APCDALVR("APCDTRX")="`"_TYPE
  1.  . S APCDALVR("APCDTSIG")=$$GET1^DIQ(90459.1414,VALUE,.04,"I")
  1.  . S APCDALVR("APCDTQTY")=$$GET1^DIQ(90459.1414,VALUE,.03,"I")
  1.  . S APCDALVR("APCDTDAY")=$$GET1^DIQ(90459.1414,VALUE,.07,"I")
  1.  ELSE  I VFILE="RAD" D
  1.  . S APCDALVR("APCDTRAD")="`"_TYPE
  1.  . S APCDALVR("APCDTABN")=VALUE
  1.  ELSE  I VFILE="XAM" D
  1.  . S APCDALVR("APCDTEX")="`"_TYPE
  1.  . S APCDALVR("APCDTRES")=VALUE
  1.  ELSE  I VFILE="EDUC" D
  1.  . S APCDALVR("APCDTTOP")="`"_TYPE
  1.  . S EDUPRO=$$GET1^DIQ(90459.1212,VALUE,.04,"I")
  1.  . S APCDALVR("APCDTPRO")=$S(EDUPRO'="":"`"_EDUPRO,1:"")
  1.  . S APCDALVR("APCDTLOU")=$$GET1^DIQ(90459.1212,VALUE,.03,"I")
  1.  . S APCDALVR("APCDTIG")=$$GET1^DIQ(90459.1212,VALUE,.06,"I")
  1.  . S APCDALVR("APCDTMIN")=$$GET1^DIQ(90459.1212,VALUE,.07,"I")
  1.  . S APCDALVR("APCDTBC")=$$GET1^DIQ(90459.1212,VALUE,.08,"I")
  1.  . S APCDALVR("APCDTOBJ")=$$GET1^DIQ(90459.1212,VALUE,.05,"I")
  1.  ELSE  I VFILE="HF" D
  1.  . S APCDALVR("APCDTHF")="`"_TYPE
  1.  ELSE  I VFILE="ELDER" D
  1.  . ; One Elder Care form per visit
  1.  . S APCDALVR("APCDTTYP")=VISIT
  1.  . S APCDALVR("FORMID")=TYPE
  1.  . S APCDALVR("TOILET")=$$GET1^DIQ(90459.1616,VALUE,".04","I")
  1.  . S APCDALVR("BATH")=$$GET1^DIQ(90459.1616,VALUE,".05","I")
  1.  . S APCDALVR("DRESS")=$$GET1^DIQ(90459.1616,VALUE,".06","I")
  1.  . S APCDALVR("TRANSFER")=$$GET1^DIQ(90459.1616,VALUE,".07","I")
  1.  . S APCDALVR("FEED")=$$GET1^DIQ(90459.1616,VALUE,".08","I")
  1.  . S APCDALVR("CONTINEN")=$$GET1^DIQ(90459.1616,VALUE,".09","I")
  1.  . S APCDALVR("FINANCES")=$$GET1^DIQ(90459.1616,VALUE,".11","I")
  1.  . S APCDALVR("COOK")=$$GET1^DIQ(90459.1616,VALUE,".12","I")
  1.  . S APCDALVR("SHOP")=$$GET1^DIQ(90459.1616,VALUE,".13","I")
  1.  . S APCDALVR("HOUSEWK")=$$GET1^DIQ(90459.1616,VALUE,".14","I")
  1.  . S APCDALVR("MEDICAT")=$$GET1^DIQ(90459.1616,VALUE,".15","I")
  1.  . S APCDALVR("TRANSP")=$$GET1^DIQ(90459.1616,VALUE,".16","I")
  1.  . S APCDALVR("CHFUNC")=$$GET1^DIQ(90459.1616,VALUE,".17","I")
  1.  . S APCDALVR("CAREGVR")=$$GET1^DIQ(90459.1616,VALUE,".18","I")
  1.  . S APCDALVR("OPROV")=$$GET1^DIQ(90459.1616,VALUE,"1202","I")
  1.  . S APCDALVR("CLINIC")=$$GET1^DIQ(90459.1616,VALUE,"1203","I")
  1.  . S APCDALVR("EPROV")=$$GET1^DIQ(90459.1616,VALUE,"1204","I")
  1.  . S APCDALVR("EXKEY")=$$GET1^DIQ(90459.1616,VALUE,"1209","I")
  1.  . S APCDALVR("OPNAME")=$$GET1^DIQ(90459.1616,VALUE,"1210","I")
  1.  ; Create V files
  1.  D EN^APCDALVR
  1.  ; Check for error
  1.  I '$G(APCDALVR("APCDAFLG")) S BKMVFIL=$G(APCDALVR("APCDADFN"))
  1.  ; Cleanup
  1.  K APCDALVR
  1.  ; Return with Visit ID or null if error
  1.  Q BKMVFIL
  1.  ;
  1.  ;