- BTPWPFNC ;VNGT/HS/ALA-Correct deleted/merged visits ; 11 Oct 2010 9:45 AM
- ;;1.2;CARE MANAGEMENT EVENT TRACKING;**1**;JUL 07,2017;Build 5
- ;
- ;
- EN ; Entry point
- NEW QIEN,DATA,FILE,FLD,VISIT,RIEN,RFIL,TRIEN,FLD,GLOB,RVIS
- NEW ACCN,VDATE,NVIS
- S QIEN=0
- F S QIEN=$O(^BTPWQ(QIEN)) Q:'QIEN D
- . S DATA=^BTPWQ(QIEN,0)
- . S VISIT=$P(DATA,U,4),RIEN=$P(DATA,U,5),RFIL=$P(DATA,U,6)
- . S TRIEN=$P(DATA,U,14),WHIEN=$P(DATA,U,9)
- . I VISIT="~" Q
- . I RFIL=""!(RFIL="~") Q
- . S FILE=$P(^BTPW(90621.1,RFIL,0),U,2),FLD=$P(^BTPW(90621.1,RFIL,0),U,3)
- . I FLD'=.01 Q
- . I FILE=9000010.09 D
- .. S ACCN=$P(DATA,U,15) I ACCN'="" Q
- .. S ACCN=$P($G(^AUPNVLAB(RIEN,0)),U,6) I ACCN="" Q
- .. S BTPWUPD(90629,QIEN_",",.15)=ACCN
- . S GLOB=$$ROOT^DILFD(FILE,"",1)
- . S RVIS=$P($G(@GLOB@(RIEN,0)),U,3)
- . I RVIS=VISIT Q
- . I $P($G(^AUPNVSIT(VISIT,0)),U,9)=0 D
- .. S NVIS=$P($G(^AUPNVSIT(VISIT,0)),U,37)
- .. ; If MERGED TO is defined, set new value
- .. I NVIS'="" D Q
- ... K VDATE
- ... S BTPWUPD(90629,QIEN_",",.04)=NVIS
- ... I $P(^AUPNVSIT(VISIT,0),U,1)\1'=$P(^AUPNVSIT(NVIS,0),U,1)\1 S VDATE=$P(^AUPNVSIT(NVIS,0),U,1)\1
- ... I $G(VDATE)'="" S BTPWUPD(90629,QIEN_",",.03)=VDATE
- ... I TRIEN'="" S BTPWUPD(90620,TRIEN_",",.04)=NVIS I $G(VDATE)'="" S BTPWUPD(90620,TRIEN_",",.03)=VDATE
- ... I WHIEN'="",$P($G(^BWPCD(WHIEN,"PCC")),U,2)=RIEN S BTPWUPD(9002086.1,WHIEN_",",5.01)=NVIS
- .. I $P(^BTPWQ(QIEN,0),U,2)=$P($G(@GLOB@(RIEN,0)),U,2),TRIEN="" S BTPWUPD(90629,QIEN_",",.01)="@"
- .. ; No merged visit found so visit is deleted
- .. I NVIS="" D
- ... ; If status is pending, delete
- ... S STAT=$P(DATA,U,8) I STAT="P" D Q
- .... NEW DIK,DA
- .... S DIK="^BTPWQ(",DA=QIEN D ^DIK
- ... ; If status is tracked and tracked event is open, close it, if closed, add comment
- ... I STAT="T" D
- .... I $P($G(^BTPWP(TRIEN,1)),U,1)="O" D
- ..... D CLOSE^BTPWPEVO(.DATA,TRIEN,4,"Associated PCC visit was deleted.")
- .... I $P($G(^BTPWP(TRIEN,1)),U,1)="C" D
- ..... NEW COM
- ..... S COM(1)="Associated PCC visit was deleted."
- ..... D WLOG^BTPWHIST(.COM,"90620:3",TRIEN_",",$G(DUZ),$G(DTTM),"Add Comment")
- ... S BTPWUPD(90629,QIEN_",",.01)="@"
- . I $D(BTPWUPD) D FILE^DIE("","BTPWUPD","ERROR")
- Q
- BTPWPFNC ;VNGT/HS/ALA-Correct deleted/merged visits ; 11 Oct 2010 9:45 AM
- +1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;**1**;JUL 07,2017;Build 5
- +2 ;
- +3 ;
- EN ; Entry point
- +1 NEW QIEN,DATA,FILE,FLD,VISIT,RIEN,RFIL,TRIEN,FLD,GLOB,RVIS
- +2 NEW ACCN,VDATE,NVIS
- +3 SET QIEN=0
- +4 FOR
- SET QIEN=$ORDER(^BTPWQ(QIEN))
- IF 'QIEN
- QUIT
- Begin DoDot:1
- +5 SET DATA=^BTPWQ(QIEN,0)
- +6 SET VISIT=$PIECE(DATA,U,4)
- SET RIEN=$PIECE(DATA,U,5)
- SET RFIL=$PIECE(DATA,U,6)
- +7 SET TRIEN=$PIECE(DATA,U,14)
- SET WHIEN=$PIECE(DATA,U,9)
- +8 IF VISIT="~"
- QUIT
- +9 IF RFIL=""!(RFIL="~")
- QUIT
- +10 SET FILE=$PIECE(^BTPW(90621.1,RFIL,0),U,2)
- SET FLD=$PIECE(^BTPW(90621.1,RFIL,0),U,3)
- +11 IF FLD'=.01
- QUIT
- +12 IF FILE=9000010.09
- Begin DoDot:2
- +13 SET ACCN=$PIECE(DATA,U,15)
- IF ACCN'=""
- QUIT
- +14 SET ACCN=$PIECE($GET(^AUPNVLAB(RIEN,0)),U,6)
- IF ACCN=""
- QUIT
- +15 SET BTPWUPD(90629,QIEN_",",.15)=ACCN
- End DoDot:2
- +16 SET GLOB=$$ROOT^DILFD(FILE,"",1)
- +17 SET RVIS=$PIECE($GET(@GLOB@(RIEN,0)),U,3)
- +18 IF RVIS=VISIT
- QUIT
- +19 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),U,9)=0
- Begin DoDot:2
- +20 SET NVIS=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,37)
- +21 ; If MERGED TO is defined, set new value
- +22 IF NVIS'=""
- Begin DoDot:3
- +23 KILL VDATE
- +24 SET BTPWUPD(90629,QIEN_",",.04)=NVIS
- +25 IF $PIECE(^AUPNVSIT(VISIT,0),U,1)\1'=$PIECE(^AUPNVSIT(NVIS,0),U,1)\1
- SET VDATE=$PIECE(^AUPNVSIT(NVIS,0),U,1)\1
- +26 IF $GET(VDATE)'=""
- SET BTPWUPD(90629,QIEN_",",.03)=VDATE
- +27 IF TRIEN'=""
- SET BTPWUPD(90620,TRIEN_",",.04)=NVIS
- IF $GET(VDATE)'=""
- SET BTPWUPD(90620,TRIEN_",",.03)=VDATE
- +28 IF WHIEN'=""
- IF $PIECE($GET(^BWPCD(WHIEN,"PCC")),U,2)=RIEN
- SET BTPWUPD(9002086.1,WHIEN_",",5.01)=NVIS
- End DoDot:3
- QUIT
- +29 IF $PIECE(^BTPWQ(QIEN,0),U,2)=$PIECE($GET(@GLOB@(RIEN,0)),U,2)
- IF TRIEN=""
- SET BTPWUPD(90629,QIEN_",",.01)="@"
- +30 ; No merged visit found so visit is deleted
- +31 IF NVIS=""
- Begin DoDot:3
- +32 ; If status is pending, delete
- +33 SET STAT=$PIECE(DATA,U,8)
- IF STAT="P"
- Begin DoDot:4
- +34 NEW DIK,DA
- +35 SET DIK="^BTPWQ("
- SET DA=QIEN
- DO ^DIK
- End DoDot:4
- QUIT
- +36 ; If status is tracked and tracked event is open, close it, if closed, add comment
- +37 IF STAT="T"
- Begin DoDot:4
- +38 IF $PIECE($GET(^BTPWP(TRIEN,1)),U,1)="O"
- Begin DoDot:5
- +39 DO CLOSE^BTPWPEVO(.DATA,TRIEN,4,"Associated PCC visit was deleted.")
- End DoDot:5
- +40 IF $PIECE($GET(^BTPWP(TRIEN,1)),U,1)="C"
- Begin DoDot:5
- +41 NEW COM
- +42 SET COM(1)="Associated PCC visit was deleted."
- +43 DO WLOG^BTPWHIST(.COM,"90620:3",TRIEN_",",$GET(DUZ),$GET(DTTM),"Add Comment")
- End DoDot:5
- End DoDot:4
- +44 SET BTPWUPD(90629,QIEN_",",.01)="@"
- End DoDot:3
- End DoDot:2
- +45 IF $DATA(BTPWUPD)
- DO FILE^DIE("","BTPWUPD","ERROR")
- End DoDot:1
- +46 QUIT
