Routine: BKMVIST3

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

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)

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

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)

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

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)

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

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)

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

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      ;

BKMVIST3.m