BKMVIST3 ;PRXM/HC/BHS - Save 90459 data to V-Files and 90451.1 ; 08 Jul 2005 1:17 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
;
RAD(DFN,VISIT,DATABASE) ; EP - File Radiology visit data from File 90459
; Input variables:
; DFN - IEN for Patient
; VISIT - Visit ID
; DATABASE - 'PCC'
; Output variables: n/a
; Initialize
N RADDATE,RADTYPE,RADCPT,ERFLAG,DA,DA0,DA1,IENS,RAD,RADABN,VISITDT,BKMTMP
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Radiology subfiles
S RAD=""
F S RAD=$O(^BKM(90459,DA1,21,"B",RAD)) Q:RAD="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,21,"B",RAD,DA0)) Q:DA0="" D
. . S DA=DA0,DA(1)=DA1
. . S IENS=$$IENS^DILF(.DA)
. . S RADDATE=RAD
. . Q:RADDATE=""
. . S RADTYPE=$$GET1^DIQ(90459.2121,IENS,.02,"I")
. . Q:RADTYPE=""
. . S RADABN=$$GET1^DIQ(90459.2121,IENS,.05,"I")
. . ;PRXM/HC/BHS - 09/28/2005 - Abnormal/Normal flag not required for the PCC API
. . ;Q:RADABN=""
. . ; Following field is a 'computed' field in the V RAD file, so compute it for display purposes.
. . ; Field might be stored in the intermediate file but it is never used.
. . S RADCPT=$$GET1^DIQ(71,RADTYPE,9,"E")
. . ; Add V-File Entry
. . S VISITDT=$P(RAD,".",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 Radiology V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2^BKMVIST4("RAD",DFN,VISIT,RADTYPE,RADABN,RADDATE,"[APCDALVR 9000010.22 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELRAD ; EP - Delete 90459.2121 Radiology subfiles
; Input variables: n/a
; Output variables: n/a
; Initialize
N DA,DA1,DA0,DIK,RAD
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Radiology subfiles
S RAD=""
F S RAD=$O(^BKM(90459,DA1,21,"B",RAD)) Q:RAD="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,21,"B",RAD,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",21,"
. . D ^DIK
Q
;
PRC(DFN,VISIT,DATABASE) ; EP - File Procedure Visit data from File 90459
; Input variables:
; DFN - IEN for Patient
; VISIT - Visit ID
; DATABASE - 'PCC'
; Output variables: n/a
; Initialize
N PRCDATE,PRCDT,PRCTYPE,PRCNAR,ERFLAG,DA,DA0,DA1,IENS,VISITDT,BKMTMP
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Procedure subfiles
S PRCDT=""
F S PRCDT=$O(^BKM(90459,DA1,20,"B",PRCDT)) Q:PRCDT="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,20,"B",PRCDT,DA0)) Q:DA0="" D
. . S DA=DA0,DA(1)=DA1
. . S IENS=$$IENS^DILF(.DA)
. . S PRCDATE=PRCDT
. . Q:PRCDATE=""
. . S PRCTYPE=$$GET1^DIQ(90459.22222,IENS,.02,"I")
. . Q:PRCTYPE=""
. . S PRCNAR=$$GET1^DIQ(90459.22222,IENS,.04,"E")
. . ; Add V-File entry
. . S VISITDT=$P(PRCDT,".",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 Procedure V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2^BKMVIST4("PRC",DFN,VISIT,PRCTYPE,PRCNAR,PRCDATE,"[APCDALVR 9000010.08 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELPRC ; EP - Delete 90459.2020 Procedure subfiles
; Input variables: n/a
; Output variables: n/a
; Initialize
N DA,DA1,DA0,DIK,PRC
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Procedure subfiles
S PRC=""
F S PRC=$O(^BKM(90459,DA1,20,"B",PRC)) Q:PRC="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,20,"B",PRC,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",20,"
. . D ^DIK
Q
;
SKIN(DFN,VISIT,DATABASE) ; EP - File Skin Visit data stored in File 90459
; Input variables:
; DFN - IEN for Patient
; VISIT - Visit ID
; DATABASE - 'PCC'
; Output variables: n/a
; Initialize
N APCDADD,ERFLAG,DA,TIENS,DA1,DA0,SDATE,SKINDT,SREADG,SREADR,BKMTMP
N STYPE,SVALUE,VISITDT
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Skin Test subfiles
S SKINDT=""
F S SKINDT=$O(^BKM(90459,DA1,22,"B",SKINDT)) Q:SKINDT="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,22,"B",SKINDT,DA0)) Q:DA0="" D
. . S SDATE=SKINDT
. . S DA=DA0,DA(1)=DA1
. . S TIENS=$$IENS^DILF(.DA)
. . S SVALUE=$$GET1^DIQ(90459.2222,TIENS,.04,"I")
. . ;Q:SVALUE=""
. . S STYPE=$$GET1^DIQ(90459.2222,TIENS,.02,"I")
. . ;Q:STYPE=""
. . S SREADG=$$GET1^DIQ(90459.2222,TIENS,.05,"I")
. . S SREADR=$$GET1^DIQ(90459.2222,TIENS,.08,"I")
. . ; Add V-File entry
. . S VISITDT=$P(SKINDT,".",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 Skin Test V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2^BKMVIST4("SKIN",DFN,VISIT,STYPE,TIENS,SDATE,"[APCDALVR 9000010.12 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELSKIN ; EP - Delete 90459.2222 Skin subfiles
; Input variables: n/a
; Output variables: n/a
; Initialize
N DA,DA1,DA0,DIK,SKN
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Skin subfiles
S SKN=""
F S SKN=$O(^BKM(90459,DA1,22,"B",SKN)) Q:SKN="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,22,"B",SKN,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",22,"
. . D ^DIK
Q
;
ELDER(DFN,VISIT,DATABASE) ; EP - File Elder Visit data from File 90459
; Input variables:
; DFN - IEN for Patient
; VISIT - Visit ID
; DATABASE - 'PCC'
; Output variables: n/a
; Initialize
N APCDALVR,DA,DA0,DA1,DATEOFR,ELDER,IENST,ELDDT,BKMTMP
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Init
K ^TMP("BKMVIST4 DATES",$J)
; Elder subfiles
S ELDER=""
F S ELDER=$O(^BKM(90459,DA1,16,"B",ELDER)) Q:ELDER="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,16,"B",ELDER,DA0)) Q:DA0="" D
. . S DA(1)=DA1,DA=DA0
. . S IENST=$$IENS^DILF(.DA)
. . S ELDDT=ELDER
. . ; Add V-File entry
. . S VISITDT=$P(ELDDT,".",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 Elder V-File entry
. . S:DATABASE="PCC" ERFLAG=$$CRVFILE2^BKMVIST4("ELDER",DFN,VISIT,"IHS-1-865",IENST,ELDDT,"[APCDALVR 9000010.35 (ADD)]")
. . I ERFLAG="" W !,"Unable to create V-File entry!" S BKMTMP=$$PAUSE^BKMIXX3()
K ^TMP("BKMVIST4 DATES",$J)
Q
;
DELELDER ; EP - Delete 90459.1616 Elder subfiles
; Input variables: n/a
; Output variables: n/a
N DA,DA1,DA0,DIK,ELDER
; PCC Buffer IEN
S DA1=$O(^BKM(90459,"B",$J,""))
Q:DA1=""
; Elder subfiles
S ELDER=""
F S ELDER=$O(^BKM(90459,DA1,16,"B",ELDER)) Q:ELDER="" D
. S DA0=""
. F S DA0=$O(^BKM(90459,DA1,16,"B",ELDER,DA0)) Q:DA0="" D
. . K DA
. . S DA(1)=DA1,DA=DA0
. . ; Delete subfile
. . S DIK="^BKM(90459,"_DA(1)_",16,"
. . D ^DIK
Q
;
;
BKMVIST3 ;PRXM/HC/BHS - Save 90459 data to V-Files and 90451.1 ; 08 Jul 2005 1:17 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 ;
RAD(DFN,VISIT,DATABASE) ; EP - File Radiology 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 RADDATE,RADTYPE,RADCPT,ERFLAG,DA,DA0,DA1,IENS,RAD,RADABN,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 ; Radiology subfiles
+14 SET RAD=""
+15 FOR
SET RAD=$ORDER(^BKM(90459,DA1,21,"B",RAD))
IF RAD=""
QUIT
Begin DoDot:1
+16 SET DA0=""
+17 FOR
SET DA0=$ORDER(^BKM(90459,DA1,21,"B",RAD,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+18 SET DA=DA0
SET DA(1)=DA1
+19 SET IENS=$$IENS^DILF(.DA)
+20 SET RADDATE=RAD
+21 IF RADDATE=""
QUIT
+22 SET RADTYPE=$$GET1^DIQ(90459.2121,IENS,.02,"I")
+23 IF RADTYPE=""
QUIT
+24 SET RADABN=$$GET1^DIQ(90459.2121,IENS,.05,"I")
+25 ;PRXM/HC/BHS - 09/28/2005 - Abnormal/Normal flag not required for the PCC API
+26 ;Q:RADABN=""
+27 ; Following field is a 'computed' field in the V RAD file, so compute it for display purposes.
+28 ; Field might be stored in the intermediate file but it is never used.
+29 SET RADCPT=$$GET1^DIQ(71,RADTYPE,9,"E")
+30 ; Add V-File Entry
+31 SET VISITDT=$PIECE(RAD,".",1)
+32 SET VISIT=$GET(^TMP("BKMVIST4 DATES",$JOB,VISITDT))
+33 ; Create PCC Visit
+34 IF VISIT=""
SET APCDADD=1
SET (^TMP("BKMVIST4 DATES",$JOB,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
+35 IF VISIT=""
WRITE !,"Unable to create PCC Visit!"
SET BKMTMP=$$PAUSE^BKMIXX3()
QUIT
+36 ; File PCC Radiology V-File entry
+37 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2^BKMVIST4("RAD",DFN,VISIT,RADTYPE,RADABN,RADDATE,"[APCDALVR 9000010.22 (ADD)]")
+38 IF ERFLAG=""
WRITE !,"Unable to create V-File entry!"
SET BKMTMP=$$PAUSE^BKMIXX3()
End DoDot:2
End DoDot:1
+39 KILL ^TMP("BKMVIST4 DATES",$JOB)
+40 QUIT
+41 ;
DELRAD ; EP - Delete 90459.2121 Radiology subfiles
+1 ; Input variables: n/a
+2 ; Output variables: n/a
+3 ; Initialize
+4 NEW DA,DA1,DA0,DIK,RAD
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; Radiology subfiles
+9 SET RAD=""
+10 FOR
SET RAD=$ORDER(^BKM(90459,DA1,21,"B",RAD))
IF RAD=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,21,"B",RAD,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)_",21,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
PRC(DFN,VISIT,DATABASE) ; EP - File Procedure 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 PRCDATE,PRCDT,PRCTYPE,PRCNAR,ERFLAG,DA,DA0,DA1,IENS,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 ; Procedure subfiles
+14 SET PRCDT=""
+15 FOR
SET PRCDT=$ORDER(^BKM(90459,DA1,20,"B",PRCDT))
IF PRCDT=""
QUIT
Begin DoDot:1
+16 SET DA0=""
+17 FOR
SET DA0=$ORDER(^BKM(90459,DA1,20,"B",PRCDT,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+18 SET DA=DA0
SET DA(1)=DA1
+19 SET IENS=$$IENS^DILF(.DA)
+20 SET PRCDATE=PRCDT
+21 IF PRCDATE=""
QUIT
+22 SET PRCTYPE=$$GET1^DIQ(90459.22222,IENS,.02,"I")
+23 IF PRCTYPE=""
QUIT
+24 SET PRCNAR=$$GET1^DIQ(90459.22222,IENS,.04,"E")
+25 ; Add V-File entry
+26 SET VISITDT=$PIECE(PRCDT,".",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 Procedure V-File entry
+32 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2^BKMVIST4("PRC",DFN,VISIT,PRCTYPE,PRCNAR,PRCDATE,"[APCDALVR 9000010.08 (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 ;
DELPRC ; EP - Delete 90459.2020 Procedure subfiles
+1 ; Input variables: n/a
+2 ; Output variables: n/a
+3 ; Initialize
+4 NEW DA,DA1,DA0,DIK,PRC
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; Procedure subfiles
+9 SET PRC=""
+10 FOR
SET PRC=$ORDER(^BKM(90459,DA1,20,"B",PRC))
IF PRC=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,20,"B",PRC,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)_",20,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
SKIN(DFN,VISIT,DATABASE) ; EP - File Skin Visit data stored in 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 APCDADD,ERFLAG,DA,TIENS,DA1,DA0,SDATE,SKINDT,SREADG,SREADR,BKMTMP
+8 NEW STYPE,SVALUE,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 ; Skin Test subfiles
+15 SET SKINDT=""
+16 FOR
SET SKINDT=$ORDER(^BKM(90459,DA1,22,"B",SKINDT))
IF SKINDT=""
QUIT
Begin DoDot:1
+17 SET DA0=""
+18 FOR
SET DA0=$ORDER(^BKM(90459,DA1,22,"B",SKINDT,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+19 SET SDATE=SKINDT
+20 SET DA=DA0
SET DA(1)=DA1
+21 SET TIENS=$$IENS^DILF(.DA)
+22 SET SVALUE=$$GET1^DIQ(90459.2222,TIENS,.04,"I")
+23 ;Q:SVALUE=""
+24 SET STYPE=$$GET1^DIQ(90459.2222,TIENS,.02,"I")
+25 ;Q:STYPE=""
+26 SET SREADG=$$GET1^DIQ(90459.2222,TIENS,.05,"I")
+27 SET SREADR=$$GET1^DIQ(90459.2222,TIENS,.08,"I")
+28 ; Add V-File entry
+29 SET VISITDT=$PIECE(SKINDT,".",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 Skin Test V-File entry
+35 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2^BKMVIST4("SKIN",DFN,VISIT,STYPE,TIENS,SDATE,"[APCDALVR 9000010.12 (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 ;
DELSKIN ; EP - Delete 90459.2222 Skin subfiles
+1 ; Input variables: n/a
+2 ; Output variables: n/a
+3 ; Initialize
+4 NEW DA,DA1,DA0,DIK,SKN
+5 ; PCC Buffer IEN
+6 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+7 IF DA1=""
QUIT
+8 ; Skin subfiles
+9 SET SKN=""
+10 FOR
SET SKN=$ORDER(^BKM(90459,DA1,22,"B",SKN))
IF SKN=""
QUIT
Begin DoDot:1
+11 SET DA0=""
+12 FOR
SET DA0=$ORDER(^BKM(90459,DA1,22,"B",SKN,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)_",22,"
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
ELDER(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 ; Output variables: n/a
+6 ; Initialize
+7 NEW APCDALVR,DA,DA0,DA1,DATEOFR,ELDER,IENST,ELDDT,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 ; Elder subfiles
+14 SET ELDER=""
+15 FOR
SET ELDER=$ORDER(^BKM(90459,DA1,16,"B",ELDER))
IF ELDER=""
QUIT
Begin DoDot:1
+16 SET DA0=""
+17 FOR
SET DA0=$ORDER(^BKM(90459,DA1,16,"B",ELDER,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+18 SET DA(1)=DA1
SET DA=DA0
+19 SET IENST=$$IENS^DILF(.DA)
+20 SET ELDDT=ELDER
+21 ; Add V-File entry
+22 SET VISITDT=$PIECE(ELDDT,".",1)
+23 SET VISIT=$GET(^TMP("BKMVIST4 DATES",$JOB,VISITDT))
+24 ; Create PCC Visit
+25 IF VISIT=""
SET APCDADD=1
SET (^TMP("BKMVIST4 DATES",$JOB,VISITDT),VISIT)=$$CRVISIT3^BKMVIST4(VISITDT,DFN)
+26 IF VISIT=""
WRITE !,"Unable to create PCC Visit!"
SET BKMTMP=$$PAUSE^BKMIXX3()
QUIT
+27 ; File PCC Elder V-File entry
+28 IF DATABASE="PCC"
SET ERFLAG=$$CRVFILE2^BKMVIST4("ELDER",DFN,VISIT,"IHS-1-865",IENST,ELDDT,"[APCDALVR 9000010.35 (ADD)]")
+29 IF ERFLAG=""
WRITE !,"Unable to create V-File entry!"
SET BKMTMP=$$PAUSE^BKMIXX3()
End DoDot:2
End DoDot:1
+30 KILL ^TMP("BKMVIST4 DATES",$JOB)
+31 QUIT
+32 ;
DELELDER ; EP - Delete 90459.1616 Elder subfiles
+1 ; Input variables: n/a
+2 ; Output variables: n/a
+3 NEW DA,DA1,DA0,DIK,ELDER
+4 ; PCC Buffer IEN
+5 SET DA1=$ORDER(^BKM(90459,"B",$JOB,""))
+6 IF DA1=""
QUIT
+7 ; Elder subfiles
+8 SET ELDER=""
+9 FOR
SET ELDER=$ORDER(^BKM(90459,DA1,16,"B",ELDER))
IF ELDER=""
QUIT
Begin DoDot:1
+10 SET DA0=""
+11 FOR
SET DA0=$ORDER(^BKM(90459,DA1,16,"B",ELDER,DA0))
IF DA0=""
QUIT
Begin DoDot:2
+12 KILL DA
+13 SET DA(1)=DA1
SET DA=DA0
+14 ; Delete subfile
+15 SET DIK="^BKM(90459,"_DA(1)_",16,"
+16 DO ^DIK
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
+19 ;
