BKMVIST5 ;PRXM/HC/JGH - Save 90459 data to V-Files and 90451.1 ; 10 Jun 2005 4:05 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
; Update PCC, V-Files, Visit File, using HMS
Q
IMMUN(DFN,VISIT,DATABASE) ; EP - File Immun Visit data from File 90459
; Input vars:
; DFN - Pat IEN
; VISIT - Visit ID
; DATABASE - 'PCC'
; Output vars: n/a
; Init
N APCDADD,DA1,DA0,DA,IIENS,ERFLAG,LOT,REACT,SERIES,TYPE,VISITDT,BKMTMP
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Immun subfiles
S IMMUN=""
F S IMMUN=$O(^BKM(90459,DA1,23,"B",IMMUN)) Q:IMMUN="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,23,"B",IMMUN,DA0)) Q:DA0="" D
. . S DA=DA0,DA(1)=DA1
. . S IIENS=$$IENS^DILF(.DA)
. . S TYPE=$$GET1^DIQ(90459.2323,IIENS,.015,"I")
. . Q:TYPE=""
. . S SERIES=$$GET1^DIQ(90459.2323,IIENS,.04,"I")
. . S LOT=$$GET1^DIQ(90459.2323,IIENS,.05,"I")
. . S REACT=$$GET1^DIQ(90459.2323,IIENS,.06,"I")
. . ; Add V-File entry
. . S VISITDT=$P(IMMUN,".",1)
. . S VISIT=$G(^TMP("BKMVIST4 DATES",$J,VISITDT))
. . ; Create PCC Visit
. . I VISIT="" S APCDADD=1,(^TMP("BKMVIST4 DATES",$J,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
. . I VISIT="" W !,"Unable to create PCC Visit!" S BKMTMP=$$PAUSE^BKMIXX3() Q
. . ; File PCC Immun V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2^BKMVIST4("IMMUN",DFN,VISIT,TYPE,IIENS,IMMUN,"[APCDALVR 9000010.11 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELIMMUN ; EP - Delete 90459.2323 Immun subfiles
; Input vars: n/a
; Output vars: n/a
; Init
N IMMUN,DA,DA0,DA1,DIK
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Immun subfiles
S IMMUN=""
F S IMMUN=$O(^BKM(90459,DA1,23,"B",IMMUN)) Q:IMMUN="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,23,"B",IMMUN,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",23,"
. . D ^DIK
Q
;
LAB(DFN,VISIT,DATABASE) ; EP - File Lab Visit data from File 90459
; Input vars:
; DFN - Pat IEN
; VISIT - Visit ID
; DATABASE - 'PCC'
; Output vars: n/a
; Init
N DA,DA0,DA1,LABDT,LABDATE,LABTYPE,LIENS,ERFLAG,BKMTMP
N LABLOW,LABRESL,LABUNIT,VISITDT,LABHIGH
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Lab subfiles
S LABDT=""
F S LABDT=$O(^BKM(90459,DA1,13,"B",LABDT)) Q:LABDT="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,13,"B",LABDT,DA0)) Q:DA0="" D
. . S DA=DA0,DA(1)=DA1
. . S LIENS=$$IENS^DILF(.DA)
. . S LABDATE=LABDT
. . S LABTYPE=$$GET1^DIQ(90459.1313,LIENS,.02,"I")
. . Q:LABTYPE?." "
. . S LABRESL=$$GET1^DIQ(90459.1313,LIENS,.03,"I")
. . S LABUNIT=$$GET1^DIQ(90459.1313,LIENS,1101,"I")
. . S LABLOW=$$GET1^DIQ(90459.1313,LIENS,1104,"I")
. . S LABHIGH=$$GET1^DIQ(90459.1313,LIENS,1105,"I")
. . ; Add V-File entry
. . S VISITDT=$P(LABDT,".",1)
. . S VISIT=$G(^TMP("BKMVIST4 DATES",$J,VISITDT))
. . ; Create PCC Visit
. . I VISIT="" S APCDADD=1,(^TMP("BKMVIST4 DATES",$J,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
. . I VISIT="" W !,"Unable to create PCC Visit!" S BKMTMP=$$PAUSE^BKMIXX3() Q
. . ; File PCC Lab V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2^BKMVIST4("LAB",DFN,VISIT,LABTYPE,LIENS,LABDATE,"[APCDALVR 9000010.09 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELLAB ; EP - Delete 90459.1313 Lab subfiles
; Input vars: n/a
; Output vars: n/a
; Init
N DA,DA1,DA0,DIK,LAB
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Lab subfiles
S LAB=""
F S LAB=$O(^BKM(90459,DA1,13,"B",LAB)) Q:LAB="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,13,"B",LAB,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",13,"
. . D ^DIK
Q
;
MED(DFN,VISIT,DATABASE) ; EP - File Med Visit data from File 90459
; Input vars:
; DFN - Pat IEN
; VISIT - Visit ID
; DATABASE - 'PCC'
; Output vars: n/a
; Init
N APCDADD,DA,DA1,DA0,MED,MEDTYPE,MEDDATE,MEDTYPE,X,G,ERFLAG,BKMTMP
N MEDDAYS,MEDDT,MEDQTY,MEDSIQ,MIENS,MSRDATE,MSRTYPE,MSRVALUE,VISITDT
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Med subfiles
S MEDDT=""
F S MEDDT=$O(^BKM(90459,DA1,14,"B",MEDDT)) Q:MEDDT="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,14,"B",MEDDT,DA0)) Q:DA0="" D
. . S DA=DA0,DA(1)=DA1
. . S MIENS=$$IENS^DILF(.DA)
. . S MEDDATE=MEDDT
. . S MEDTYPE=$$GET1^DIQ(90459.1414,MIENS,.02,"I")
. . Q:MEDTYPE?." "
. . S MEDQTY=$$GET1^DIQ(90459.1414,MIENS,.03,"I")
. . S MEDSIQ=$$GET1^DIQ(90459.1414,MIENS,.04,"I")
. . S MEDDAYS=$$GET1^DIQ(90459.1414,MIENS,.07,"I")
. . ; Add V-File entry
. . S VISITDT=$P(MEDDT,".",1)
. . S VISIT=$G(^TMP("BKMVIST4 DATES",$J,VISITDT))
. . ; Create PCC Visit
. . I VISIT="" S APCDADD=1,(^TMP("BKMVIST4 DATES",$J,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
. . I VISIT="" W !,"Unable to create PCC Visit!" S BKMTMP=$$PAUSE^BKMIXX3() Q
. . ; File PCC Med V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2^BKMVIST4("MED",DFN,VISIT,MEDTYPE,MIENS,MEDDATE,"[APCDALVR 9000010.14 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELMED ; EP - Delete 90459.1414 Med subfiles
; Input vars: n/a
; Output vars: n/a
; Init
N DA,DA1,DA0,DIK,MED
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Med subfiles
S MED=""
F S MED=$O(^BKM(90459,DA1,14,"B",MED)) Q:MED="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,14,"B",MED,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",14,"
. . D ^DIK
Q
;
XAM(DFN,VISIT,DATABASE) ; EP - File Exam Visit data from File 90459
; Input vars:
; DFN - Pat IEN
; VISIT - Visit ID
; DATABASE - 'PCC'
; Init
N APCDADD,XAMDATE,XAMTYPE,XAMVALUE,ERFLAG,DA,DA0,DA1,IENS,VISITDT,XAM,BKMTMP
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Exam subfiles
S XAM=""
F S XAM=$O(^BKM(90459,DA1,17,"B",XAM)) Q:XAM="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,17,"B",XAM,DA0)) Q:DA0="" D
. . S DA=DA0,DA(1)=DA1
. . S IENS=$$IENS^DILF(.DA)
. . S XAMDATE=XAM
. . Q:XAMDATE=""
. . S XAMTYPE=$$GET1^DIQ(90459.1717,IENS,.02,"I")
. . Q:XAMTYPE=""
. . S XAMVALUE=$$GET1^DIQ(90459.1717,IENS,.04,"I")
. . ;PRXM/HC/BHS - Remove as field is not required to file
. . ;Q:XAMVALUE=""
. . ; Add V-File entry
. . S VISITDT=$P(XAM,".",1)
. . S VISIT=$G(^TMP("BKMVIST4 DATES",$J,VISITDT))
. . ; Create PCC Visit
. . I VISIT="" S APCDADD=1,(^TMP("BKMVIST4 DATES",$J,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
. . I VISIT="" W !,"Unable to create PCC Visit!" S BKMTMP=$$PAUSE^BKMIXX3() Q
. . ; File PCC Exam V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2^BKMVIST4("XAM",DFN,VISIT,XAMTYPE,XAMVALUE,XAMDATE,"[APCDALVR 9000010.13 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELXAM ; EP - Delete 90459.1717 Exam subfiles
; Input vars: n/a
; Output vars: n/a
; Init
N DA,DA1,DA0,DIK,XAM
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Exam subfiles
S XAM=""
F S XAM=$O(^BKM(90459,DA1,17,"B",XAM)) Q:XAM="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,17,"B",XAM,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",17,"
. . D ^DIK
Q
;
MSR(DFN,VISIT,DATABASE) ; EP - File Measurement Visit data from File 90459
; Input vars:
; DFN - Pat IEN
; VISIT - Visit ID
; DATABASE - 'PCC'
; Init
N APCDADD,DMSR,MSR,DA0,DA,DA1,IENS,MSRDATE,MSRVALUE,MSRTYPE,ERFLAG,VISITDT,BKMTMP
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Measurement subfiles
S DMSR=""
F S DMSR=$O(^BKM(90459,DA1,19,"B",DMSR)) Q:DMSR="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,19,"B",DMSR,DA0)) Q:DA0="" D
. . S DA=DA0,DA(1)=DA1
. . S IENS=$$IENS^DILF(.DA)
. . S MSRVALUE=$$GET1^DIQ(90459.1919,IENS,.04,"I")
. . S MSRDATE=DMSR
. . S MSRTYPE=$$GET1^DIQ(90459.1919,IENS,.02,"I")
. . I MSRVALUE?." "!(MSRDATE?." ")!(MSRTYPE?." ") Q
. . ; Add V-File entry
. . S VISITDT=$P(DMSR,".",1)
. . S VISIT=$G(^TMP("BKMVIST4 DATES",$J,VISITDT))
. . ; Create PCC Visit
. . I VISIT="" S APCDADD=1,(^TMP("BKMVIST4 DATES",$J,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
. . I VISIT="" W !,"Unable to create PCC Visit!" S BKMTMP=$$PAUSE^BKMIXX3() Q
. . ; File PCC Measurement V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2^BKMVIST4("MSR",DFN,VISIT,MSRTYPE,MSRVALUE,MSRDATE,"[APCDALVR 9000010.01 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELMSR ; EP - Delete 90459.1919 Measurement subfiles
; Input vars: n/a
; Output vars: n/a
; Init
N DA,DA1,DA0,DIK,MSR
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Measurement subfiles
S MSR=""
F S MSR=$O(^BKM(90459,DA1,19,"B",MSR)) Q:MSR="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,19,"B",MSR,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",19,"
. . D ^DIK
Q
;
;
BKMVIST5 ;PRXM/HC/JGH - Save 90459 data to V-Files and 90451.1 ; 10 Jun 2005 4:05 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ; Update PCC, V-Files, Visit File, using HMS
+4 QUIT
IMMUN(DFN,VISIT,DATABASE) ; EP - File Immun Visit data from File 90459
+1 ; Input vars:
+2 ; DFN - Pat IEN
+3 ; VISIT - Visit ID
+4 ; DATABASE - 'PCC'
+5 ; Output vars: n/a
+6 ; Init
+7 NEW APCDADD,DA1,DA0,DA,IIENS,ERFLAG,LOT,REACT,SERIES,TYPE,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 ; Immun subfiles
+14 SET IMMUN=""
+15 FOR
SET IMMUN=$ORDER(^BKM(90459,DA1,23,"B",IMMUN))
IF IMMUN=""
QUIT
Begin DoDot:1
+16 SET DA0=""
+17 FOR
SET DA0=$ORDER(^BKM(90459,DA1,23,"B",IMMUN,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+18 SET DA=DA0
SET DA(1)=DA1
+19 SET IIENS=$$IENS^DILF(.DA)
+20 SET TYPE=$$GET1^DIQ(90459.2323,IIENS,.015,"I")
+21 IF TYPE=""
QUIT
+22 SET SERIES=$$GET1^DIQ(90459.2323,IIENS,.04,"I")
+23 SET LOT=$$GET1^DIQ(90459.2323,IIENS,.05,"I")
+24 SET REACT=$$GET1^DIQ(90459.2323,IIENS,.06,"I")
+25 ; Add V-File entry
+26 SET VISITDT=$PIECE(IMMUN,".",1)
+27 SET VISIT=$GET(^TMP("BKMVIST4 DATES",$JOB,VISITDT))
+28 ; Create PCC Visit
+29 IF VISIT=""
SET APCDADD=1
SET (^TMP("BKMVIST4 DATES",$JOB,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
+30 IF VISIT=""
WRITE !,"Unable to create PCC Visit!"
SET BKMTMP=$$PAUSE^BKMIXX3()
QUIT
+31 ; File PCC Immun V-File entry
+32 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2^BKMVIST4("IMMUN",DFN,VISIT,TYPE,IIENS,IMMUN,"[APCDALVR 9000010.11 (ADD)]")
+33 IF ERFLAG=""
WRITE !,"Unable to create V-File entry!"
SET BKMTMP=$$PAUSE^BKMIXX3()
End DoDot:2
End DoDot:1
+34 KILL ^TMP("BKMVIST4 DATES",$JOB)
+35 QUIT
+36 ;
DELIMMUN ; EP - Delete 90459.2323 Immun subfiles
+1 ; Input vars: n/a
+2 ; Output vars: n/a
+3 ; Init
+4 NEW IMMUN,DA,DA0,DA1,DIK
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; Immun subfiles
+9 SET IMMUN=""
+10 FOR
SET IMMUN=$ORDER(^BKM(90459,DA1,23,"B",IMMUN))
IF IMMUN=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,23,"B",IMMUN,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)_",23,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
LAB(DFN,VISIT,DATABASE) ; EP - File Lab Visit data from File 90459
+1 ; Input vars:
+2 ; DFN - Pat IEN
+3 ; VISIT - Visit ID
+4 ; DATABASE - 'PCC'
+5 ; Output vars: n/a
+6 ; Init
+7 NEW DA,DA0,DA1,LABDT,LABDATE,LABTYPE,LIENS,ERFLAG,BKMTMP
+8 NEW LABLOW,LABRESL,LABUNIT,VISITDT,LABHIGH
+9 ; PCC Buffer IEN
+10 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+11 IF DA1=""
QUIT
+12 ; Init
+13 KILL ^TMP("BKMVIST4 DATES",$JOB)
+14 ; Lab subfiles
+15 SET LABDT=""
+16 FOR
SET LABDT=$ORDER(^BKM(90459,DA1,13,"B",LABDT))
IF LABDT=""
QUIT
Begin DoDot:1
+17 SET DA0=""
+18 FOR
SET DA0=$ORDER(^BKM(90459,DA1,13,"B",LABDT,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+19 SET DA=DA0
SET DA(1)=DA1
+20 SET LIENS=$$IENS^DILF(.DA)
+21 SET LABDATE=LABDT
+22 SET LABTYPE=$$GET1^DIQ(90459.1313,LIENS,.02,"I")
+23 IF LABTYPE?." "
QUIT
+24 SET LABRESL=$$GET1^DIQ(90459.1313,LIENS,.03,"I")
+25 SET LABUNIT=$$GET1^DIQ(90459.1313,LIENS,1101,"I")
+26 SET LABLOW=$$GET1^DIQ(90459.1313,LIENS,1104,"I")
+27 SET LABHIGH=$$GET1^DIQ(90459.1313,LIENS,1105,"I")
+28 ; Add V-File entry
+29 SET VISITDT=$PIECE(LABDT,".",1)
+30 SET VISIT=$GET(^TMP("BKMVIST4 DATES",$JOB,VISITDT))
+31 ; Create PCC Visit
+32 IF VISIT=""
SET APCDADD=1
SET (^TMP("BKMVIST4 DATES",$JOB,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
+33 IF VISIT=""
WRITE !,"Unable to create PCC Visit!"
SET BKMTMP=$$PAUSE^BKMIXX3()
QUIT
+34 ; File PCC Lab V-File entry
+35 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2^BKMVIST4("LAB",DFN,VISIT,LABTYPE,LIENS,LABDATE,"[APCDALVR 9000010.09 (ADD)]")
+36 IF ERFLAG=""
WRITE !,"Unable to create V-File entry!"
SET BKMTMP=$$PAUSE^BKMIXX3()
End DoDot:2
End DoDot:1
+37 KILL ^TMP("BKMVIST4 DATES",$JOB)
+38 QUIT
+39 ;
DELLAB ; EP - Delete 90459.1313 Lab subfiles
+1 ; Input vars: n/a
+2 ; Output vars: n/a
+3 ; Init
+4 NEW DA,DA1,DA0,DIK,LAB
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; Lab subfiles
+9 SET LAB=""
+10 FOR
SET LAB=$ORDER(^BKM(90459,DA1,13,"B",LAB))
IF LAB=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,13,"B",LAB,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)_",13,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
MED(DFN,VISIT,DATABASE) ; EP - File Med Visit data from File 90459
+1 ; Input vars:
+2 ; DFN - Pat IEN
+3 ; VISIT - Visit ID
+4 ; DATABASE - 'PCC'
+5 ; Output vars: n/a
+6 ; Init
+7 NEW APCDADD,DA,DA1,DA0,MED,MEDTYPE,MEDDATE,MEDTYPE,X,G,ERFLAG,BKMTMP
+8 NEW MEDDAYS,MEDDT,MEDQTY,MEDSIQ,MIENS,MSRDATE,MSRTYPE,MSRVALUE,VISITDT
+9 ; PCC Buffer IEN
+10 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+11 IF DA1=""
QUIT
+12 ; Init
+13 KILL ^TMP("BKMVIST4 DATES",$JOB)
+14 ; Med subfiles
+15 SET MEDDT=""
+16 FOR
SET MEDDT=$ORDER(^BKM(90459,DA1,14,"B",MEDDT))
IF MEDDT=""
QUIT
Begin DoDot:1
+17 SET DA0=""
+18 FOR
SET DA0=$ORDER(^BKM(90459,DA1,14,"B",MEDDT,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+19 SET DA=DA0
SET DA(1)=DA1
+20 SET MIENS=$$IENS^DILF(.DA)
+21 SET MEDDATE=MEDDT
+22 SET MEDTYPE=$$GET1^DIQ(90459.1414,MIENS,.02,"I")
+23 IF MEDTYPE?." "
QUIT
+24 SET MEDQTY=$$GET1^DIQ(90459.1414,MIENS,.03,"I")
+25 SET MEDSIQ=$$GET1^DIQ(90459.1414,MIENS,.04,"I")
+26 SET MEDDAYS=$$GET1^DIQ(90459.1414,MIENS,.07,"I")
+27 ; Add V-File entry
+28 SET VISITDT=$PIECE(MEDDT,".",1)
+29 SET VISIT=$GET(^TMP("BKMVIST4 DATES",$JOB,VISITDT))
+30 ; Create PCC Visit
+31 IF VISIT=""
SET APCDADD=1
SET (^TMP("BKMVIST4 DATES",$JOB,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
+32 IF VISIT=""
WRITE !,"Unable to create PCC Visit!"
SET BKMTMP=$$PAUSE^BKMIXX3()
QUIT
+33 ; File PCC Med V-File entry
+34 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2^BKMVIST4("MED",DFN,VISIT,MEDTYPE,MIENS,MEDDATE,"[APCDALVR 9000010.14 (ADD)]")
+35 IF ERFLAG=""
WRITE !,"Unable to create V-File entry!"
SET BKMTMP=$$PAUSE^BKMIXX3()
End DoDot:2
End DoDot:1
+36 KILL ^TMP("BKMVIST4 DATES",$JOB)
+37 QUIT
+38 ;
DELMED ; EP - Delete 90459.1414 Med subfiles
+1 ; Input vars: n/a
+2 ; Output vars: n/a
+3 ; Init
+4 NEW DA,DA1,DA0,DIK,MED
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; Med subfiles
+9 SET MED=""
+10 FOR
SET MED=$ORDER(^BKM(90459,DA1,14,"B",MED))
IF MED=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,14,"B",MED,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)_",14,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
XAM(DFN,VISIT,DATABASE) ; EP - File Exam Visit data from File 90459
+1 ; Input vars:
+2 ; DFN - Pat IEN
+3 ; VISIT - Visit ID
+4 ; DATABASE - 'PCC'
+5 ; Init
+6 NEW APCDADD,XAMDATE,XAMTYPE,XAMVALUE,ERFLAG,DA,DA0,DA1,IENS,VISITDT,XAM,BKMTMP
+7 ; PCC Buffer IEN
+8 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+9 IF DA1=""
QUIT
+10 ; Init
+11 KILL ^TMP("BKMVIST4 DATES",$JOB)
+12 ; Exam subfiles
+13 SET XAM=""
+14 FOR
SET XAM=$ORDER(^BKM(90459,DA1,17,"B",XAM))
IF XAM=""
QUIT
Begin DoDot:1
+15 SET DA0=""
+16 FOR
SET DA0=$ORDER(^BKM(90459,DA1,17,"B",XAM,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+17 SET DA=DA0
SET DA(1)=DA1
+18 SET IENS=$$IENS^DILF(.DA)
+19 SET XAMDATE=XAM
+20 IF XAMDATE=""
QUIT
+21 SET XAMTYPE=$$GET1^DIQ(90459.1717,IENS,.02,"I")
+22 IF XAMTYPE=""
QUIT
+23 SET XAMVALUE=$$GET1^DIQ(90459.1717,IENS,.04,"I")
+24 ;PRXM/HC/BHS - Remove as field is not required to file
+25 ;Q:XAMVALUE=""
+26 ; Add V-File entry
+27 SET VISITDT=$PIECE(XAM,".",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^BKMVIST4(VISITDT,DFN)
+31 IF VISIT=""
WRITE !,"Unable to create PCC Visit!"
SET BKMTMP=$$PAUSE^BKMIXX3()
QUIT
+32 ; File PCC Exam V-File entry
+33 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2^BKMVIST4("XAM",DFN,VISIT,XAMTYPE,XAMVALUE,XAMDATE,"[APCDALVR 9000010.13 (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 ;
DELXAM ; EP - Delete 90459.1717 Exam subfiles
+1 ; Input vars: n/a
+2 ; Output vars: n/a
+3 ; Init
+4 NEW DA,DA1,DA0,DIK,XAM
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; Exam subfiles
+9 SET XAM=""
+10 FOR
SET XAM=$ORDER(^BKM(90459,DA1,17,"B",XAM))
IF XAM=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,17,"B",XAM,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)_",17,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
MSR(DFN,VISIT,DATABASE) ; EP - File Measurement Visit data from File 90459
+1 ; Input vars:
+2 ; DFN - Pat IEN
+3 ; VISIT - Visit ID
+4 ; DATABASE - 'PCC'
+5 ; Init
+6 NEW APCDADD,DMSR,MSR,DA0,DA,DA1,IENS,MSRDATE,MSRVALUE,MSRTYPE,ERFLAG,VISITDT,BKMTMP
+7 ; PCC Buffer IEN
+8 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+9 IF DA1=""
QUIT
+10 ; Init
+11 KILL ^TMP("BKMVIST4 DATES",$JOB)
+12 ; Measurement subfiles
+13 SET DMSR=""
+14 FOR
SET DMSR=$ORDER(^BKM(90459,DA1,19,"B",DMSR))
IF DMSR=""
QUIT
Begin DoDot:1
+15 SET DA0=""
+16 FOR
SET DA0=$ORDER(^BKM(90459,DA1,19,"B",DMSR,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+17 SET DA=DA0
SET DA(1)=DA1
+18 SET IENS=$$IENS^DILF(.DA)
+19 SET MSRVALUE=$$GET1^DIQ(90459.1919,IENS,.04,"I")
+20 SET MSRDATE=DMSR
+21 SET MSRTYPE=$$GET1^DIQ(90459.1919,IENS,.02,"I")
+22 IF MSRVALUE?." "!(MSRDATE?." ")!(MSRTYPE?." ")
QUIT
+23 ; Add V-File entry
+24 SET VISITDT=$PIECE(DMSR,".",1)
+25 SET VISIT=$GET(^TMP("BKMVIST4 DATES",$JOB,VISITDT))
+26 ; Create PCC Visit
+27 IF VISIT=""
SET APCDADD=1
SET (^TMP("BKMVIST4 DATES",$JOB,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
+28 IF VISIT=""
WRITE !,"Unable to create PCC Visit!"
SET BKMTMP=$$PAUSE^BKMIXX3()
QUIT
+29 ; File PCC Measurement V-File entry
+30 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2^BKMVIST4("MSR",DFN,VISIT,MSRTYPE,MSRVALUE,MSRDATE,"[APCDALVR 9000010.01 (ADD)]")
+31 IF ERFLAG=""
WRITE !,"Unable to create V-File entry!"
SET BKMTMP=$$PAUSE^BKMIXX3()
End DoDot:2
End DoDot:1
+32 KILL ^TMP("BKMVIST4 DATES",$JOB)
+33 QUIT
+34 ;
DELMSR ; EP - Delete 90459.1919 Measurement subfiles
+1 ; Input vars: n/a
+2 ; Output vars: n/a
+3 ; Init
+4 NEW DA,DA1,DA0,DIK,MSR
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; Measurement subfiles
+9 SET MSR=""
+10 FOR
SET MSR=$ORDER(^BKM(90459,DA1,19,"B",MSR))
IF MSR=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,19,"B",MSR,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)_",19,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
+20 ;
