- APCDKDE1 ; IHS/CMI/LAB - cont. of APCDKDE data entry visit re-linker ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- ;
- NONXCHK ;EP - called from APCDKDE to review A visits
- ;go through all V file entries on other visit
- S APCDKV=APCDKXVS D PROCVF
- S APCDKV=APCDVSIT D PROCVF
- K APCDKV,APCDKOSP,APCDKOPP,APCDK12N,APCDK("C"),APCDKVFL,APCDKIGR,APCDKVDG,APCDVDFN,APCDK("SCORE")
- Q
- PROCVF ;process v files
- I APCDVSIT'=APCDKV NEW X,P,S S (S,X)=0,APCDKOSP="" F S X=$O(^AUPNVPRV("AD",APCDKV,X)) Q:X'=+X S:$P(^AUPNVPRV(X,0),U,4)="P" APCDKOPP=+^(0) I $P(^(0),U,4)="S"!($P(^(0),U,4)="") S S=S+1,$P(APCDKOSP,U,S)=+^(0)
- S APCDKVFL=9000010 F S APCDKVFL=$O(^DIC(APCDKVFL)) Q:APCDKVFL>9000010.99!(APCDKVFL'=+APCDKVFL) D VENTRIES
- Q
- ;
- VENTRIES ;
- S APCDKVDG=^DIC(APCDKVFL,0,"GL"),APCDKIGR=APCDKVDG_"""AD"",APCDKV,APCDVDFN)"
- S APCDVDFN="" F APCDVI=1:1 S APCDVDFN=$O(@APCDKIGR) Q:APCDVDFN="" D SCORE
- Q
- ;
- SCORE ;
- Q:$D(APCDK("C",APCDKVFL,APCDVDFN)) ;quit if already reviewe
- S APCDK("C",APCDKVFL,APCDVDFN)=""
- S APCDK12N=APCDKVDG_APCDVDFN_",12)"
- Q:'$D(@(APCDK12N))
- S APCDK12N=@(APCDK12N)
- Q:APCDK12N=""
- S APCDK("SCORE CLIN")=$P(^AUPNVSIT(APCDKXVS,0),U,8),APCDK("SCORE")="APCDKOVS",@APCDK("SCORE")=0,APCDK("SCORE PP")=APCDKOPP,APCDK("SCORE SP")=APCDKOSP D SCORE1
- S APCDK("SCORE CLIN")=$P(APCDKDVR,U,8),APCDK("SCORE")="APCDKDVS",@APCDK("SCORE")=0,APCDK("SCORE PP")=APCDKDPP,APCDK("SCORE SP")=APCDKDSP D SCORE1
- I APCDKV=APCDVSIT,APCDKOVS>APCDKDVS S APCDK("REPOINT V")=APCDKXVS D RELINK Q
- I APCDKV=APCDKXVS,APCDKDVS>APCDKOVS S APCDK("REPOINT V")=APCDVSIT D RELINK Q
- Q
- SCORE1 ;
- CLINIC ;check clinic
- ;if both v record clinic and visit record clinic are not null, and they match, re-link v record and quit
- I $P(APCDK12N,U,3)]"",APCDK("SCORE CLIN")]"",$P(APCDK12N,U,3)=APCDK("SCORE CLIN") S @APCDK("SCORE")=@APCDK("SCORE")+1
- ENCPROV ;
- ;if both v record encounter provider and any provider in V Provider for this visit match, re-link and quit (both must have a value)
- G:$P(APCDK12N,U,4)="" ORDPROV
- I $G(APCDK("SCORE PP"))=$P(APCDK12N,U,4) S @APCDK("SCORE")=@APCDK("SCORE")+1
- S X=0 F I=1:1 S X=$P(APCDK("SCORE SP"),U,I) Q:X="" I $P(APCDK12N,U,4)=X S @APCDK("SCORE")=@APCDK("SCORE")+1
- ORDPROV ;
- G:$P(APCDK12N,U,2)="" SCOREXIT
- I $G(APCDK("SCORE PP"))=$P(APCDK12N,U,2) S @APCDK("SCORE")=@APCDK("SCORE")+1
- S X=0 F I=1:1 S X=$P(APCDK("SCORE SP"),U,I) Q:X="" I $P(APCDK12N,U,2)=X S @APCDK("SCORE")=@APCDK("SCORE")+1
- SCOREXIT ;
- Q
- RELINK ;repoint v file entry
- K DIE,DR,DA,DIU,DIV S DITC="",DA=APCDVDFN,DIE=APCDKVDG,DR=".03////"_APCDVSIT D ^DIE K DIE,DA,DR,DIU,DIV,DITC
- Q
- SCOREV ;check visit to see if should be deleted
- Q
- APCDKDE1 ; IHS/CMI/LAB - cont. of APCDKDE data entry visit re-linker ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;
- +3 ;
- NONXCHK ;EP - called from APCDKDE to review A visits
- +1 ;go through all V file entries on other visit
- +2 SET APCDKV=APCDKXVS
- DO PROCVF
- +3 SET APCDKV=APCDVSIT
- DO PROCVF
- +4 KILL APCDKV,APCDKOSP,APCDKOPP,APCDK12N,APCDK("C"),APCDKVFL,APCDKIGR,APCDKVDG,APCDVDFN,APCDK("SCORE")
- +5 QUIT
- PROCVF ;process v files
- +1 IF APCDVSIT'=APCDKV
- NEW X,P,S
- SET (S,X)=0
- SET APCDKOSP=""
- FOR
- SET X=$ORDER(^AUPNVPRV("AD",APCDKV,X))
- IF X'=+X
- QUIT
- IF $PIECE(^AUPNVPRV(X,0),U,4)="P"
- SET APCDKOPP=+^(0)
- IF $PIECE(^(0),U,4)="S"!($PIECE(^(0),U,4)="")
- SET S=S+1
- SET $PIECE(APCDKOSP,U,S)=+^(0)
- +2 SET APCDKVFL=9000010
- FOR
- SET APCDKVFL=$ORDER(^DIC(APCDKVFL))
- IF APCDKVFL>9000010.99!(APCDKVFL'=+APCDKVFL)
- QUIT
- DO VENTRIES
- +3 QUIT
- +4 ;
- VENTRIES ;
- +1 SET APCDKVDG=^DIC(APCDKVFL,0,"GL")
- SET APCDKIGR=APCDKVDG_"""AD"",APCDKV,APCDVDFN)"
- +2 SET APCDVDFN=""
- FOR APCDVI=1:1
- SET APCDVDFN=$ORDER(@APCDKIGR)
- IF APCDVDFN=""
- QUIT
- DO SCORE
- +3 QUIT
- +4 ;
- SCORE ;
- +1 ;quit if already reviewe
- IF $DATA(APCDK("C",APCDKVFL,APCDVDFN))
- QUIT
- +2 SET APCDK("C",APCDKVFL,APCDVDFN)=""
- +3 SET APCDK12N=APCDKVDG_APCDVDFN_",12)"
- +4 IF '$DATA(@(APCDK12N))
- QUIT
- +5 SET APCDK12N=@(APCDK12N)
- +6 IF APCDK12N=""
- QUIT
- +7 SET APCDK("SCORE CLIN")=$PIECE(^AUPNVSIT(APCDKXVS,0),U,8)
- SET APCDK("SCORE")="APCDKOVS"
- SET @APCDK("SCORE")=0
- SET APCDK("SCORE PP")=APCDKOPP
- SET APCDK("SCORE SP")=APCDKOSP
- DO SCORE1
- +8 SET APCDK("SCORE CLIN")=$PIECE(APCDKDVR,U,8)
- SET APCDK("SCORE")="APCDKDVS"
- SET @APCDK("SCORE")=0
- SET APCDK("SCORE PP")=APCDKDPP
- SET APCDK("SCORE SP")=APCDKDSP
- DO SCORE1
- +9 IF APCDKV=APCDVSIT
- IF APCDKOVS>APCDKDVS
- SET APCDK("REPOINT V")=APCDKXVS
- DO RELINK
- QUIT
- +10 IF APCDKV=APCDKXVS
- IF APCDKDVS>APCDKOVS
- SET APCDK("REPOINT V")=APCDVSIT
- DO RELINK
- QUIT
- +11 QUIT
- SCORE1 ;
- CLINIC ;check clinic
- +1 ;if both v record clinic and visit record clinic are not null, and they match, re-link v record and quit
- +2 IF $PIECE(APCDK12N,U,3)]""
- IF APCDK("SCORE CLIN")]""
- IF $PIECE(APCDK12N,U,3)=APCDK("SCORE CLIN")
- SET @APCDK("SCORE")=@APCDK("SCORE")+1
- ENCPROV ;
- +1 ;if both v record encounter provider and any provider in V Provider for this visit match, re-link and quit (both must have a value)
- +2 IF $PIECE(APCDK12N,U,4)=""
- GOTO ORDPROV
- +3 IF $GET(APCDK("SCORE PP"))=$PIECE(APCDK12N,U,4)
- SET @APCDK("SCORE")=@APCDK("SCORE")+1
- +4 SET X=0
- FOR I=1:1
- SET X=$PIECE(APCDK("SCORE SP"),U,I)
- IF X=""
- QUIT
- IF $PIECE(APCDK12N,U,4)=X
- SET @APCDK("SCORE")=@APCDK("SCORE")+1
- ORDPROV ;
- +1 IF $PIECE(APCDK12N,U,2)=""
- GOTO SCOREXIT
- +2 IF $GET(APCDK("SCORE PP"))=$PIECE(APCDK12N,U,2)
- SET @APCDK("SCORE")=@APCDK("SCORE")+1
- +3 SET X=0
- FOR I=1:1
- SET X=$PIECE(APCDK("SCORE SP"),U,I)
- IF X=""
- QUIT
- IF $PIECE(APCDK12N,U,2)=X
- SET @APCDK("SCORE")=@APCDK("SCORE")+1
- SCOREXIT ;
- +1 QUIT
- RELINK ;repoint v file entry
- +1 KILL DIE,DR,DA,DIU,DIV
- SET DITC=""
- SET DA=APCDVDFN
- SET DIE=APCDKVDG
- SET DR=".03////"_APCDVSIT
- DO ^DIE
- KILL DIE,DA,DR,DIU,DIV,DITC
- +2 QUIT
- SCOREV ;check visit to see if should be deleted
- +1 QUIT
