DGPTFQWK ;ALB/AS - QUICK/LOAD PTF DATA ;7/21/05 2:44pm
;;5.3;Registration;**517,594,635,729,1015**;Aug 13, 1993;Build 21
;
S (DGPTF,DA)=PTF,DIE="^DGPT(",DR="[DGQWK"_$S('DGPTFE:"]",1:"F]") W !,"* editing 101 & 701 transactions" D ^DIE S DR="[DG701]" D ^DIE W !,"* editing 501 transactions"
F DGM=0:0 D S501 Q:Y'>0 K DA S (DGPTF,DA)=PTF S DGMOV=+Y,DGJUMP=$S('DGPTFE:"",1:"1-2"),DR=$S('DGPTFE:"[DG501]",1:"[DG501F]"),DIE="^DGPT(" D ^DIE,CHK501^DGPTSCAN K DGMOV
K DIC,DA,DR,DIE
W !,"* editing 401 transactions"
F DGM=0:0 D S401 Q:Y'>0 K DA S DGSUR=+Y,DGJUMP="1-2",DR="[DG401]",DIE="^DGPT(",(DA,DGPTF)=PTF D ^DIE,CHK401^DGPTSCAN K DGSUR
I '$P(^DGPT(PTF,0),U,4) W !,"* editing 801 transactions" D S801
K DIC,DA,DR,DIE
W !,"* editing 601 transactions"
F DGM=0:0 S DGZP=1 D S601 Q:Y'>0 K DA S P(DGZP,1)=+Y,DGJUMP="1-2",DR="[DG601]",DIE="^DGPT(",(DA,DGPTF)=PTF D ^DIE,CHK601^DGPTSCAN K P
K DIC,DA,DR,DIE
;S DR="60",DR(2,45.05)=".01;2;S:'X Y=4;3;4:8",DIE="^DGPT(",DA=PTF D ^DIE
I '$P(^DGPT(PTF,0),"^",4)&('DGST) W !," Updating TRANSFER DRGs" S DGADM=$P(^DGPT(PTF,0),U,2) D SUDO1^DGPTSUDO
K DGM,DA,DGMOVENO,DIC,DIE,DR,Y,DGPTF,DGJUMP Q
S501 ;-- set up 501
S DA(1)=PTF,DIC("A")="Select 501 MOVEMENT NUMBER: ",DIC(0)="AEQ",DIC="^DGPT("_PTF_",""M""," S:'$D(^DGPT(PTF,"M",0)) ^(0)="^45.02AI^^" D ^DIC
K DA,DIC
Q
;
S401 ;-- set up 401
S DA(1)=PTF,DIC("A")="Select 401 SURGERY DATE: ",DIC(0)="AEQL",DIC="^DGPT("_PTF_",""S""," S:'$D(^DGPT(PTF,"S",0)) ^(0)="^45.01DA^^" D ^DIC
K DA,DIC
Q
;
S601 ;-- set up 601
S DA(1)=PTF,DIC("A")="Select 601 PROCEDURE DATE: ",DIC(0)="AEQL",DIC="^DGPT("_PTF_",""P""," S:'$D(^DGPT(PTF,"P",0)) ^(0)="^45.05DA^^" D ^DIC
K DA,DIC
Q
S801 ;-- set up 801
F D D REQ:$D(PSIEN) Q:$G(RFL)=1!(Y<0) D PCE
.S DIC("A")="Select 801 CPT DATE/TIME: "
.S DA(1)=PTF,DIC(0)="AEQLZ",DIC="^DGPT("_PTF_",""C"",",DLAYGO=45
.S:'$D(^DGPT(PTF,"C",0)) ^(0)="^45.06^^" D ^DIC
.K DA,DIC,PSIEN Q:Y'>0 S DGPRD=+Y(0),DGPSM=+Y D MOB^DGPTFM2 I $P(DGZPRF,U,3) F I=1:1:$P(DGZPRF,U,3) S:DGZPRF(I,0)=DGPSM DGZP=I
.S (DA(1),REC)=PTF,DIE="^DGPT("_PTF_",""C"",",(DA,PSIEN)=DGZPRF(DGZP,0),DR=".02;.03;.05" D FMDIE I $D(Y)>9!$D(DTOUT) S Y=-1 Q
.S DGI=0,DR=".01;" D CL^SDCO21(DFN,DGPRD,"",.SDCLY) D S Y=1
..F S DGI=$O(^DGCPT(46,"C",PTF,DGI)) Q:DGI'>0 I +^DGCPT(46,DGI,1)=+DGZPRF(DGZP)&'$D(^(9)) S (DA,REC)=DGI,DR=".01;",DIE="^DGCPT(46," D GETINFO^DGPTFM21
..F S DA=PTF,DIC="^DGCPT(46,",DIC(0)="AELQMZ",DLAYGO=46,DIC("S")="D EN6^DGPTFJC I 'DGER" D ^DIC K DIC Q:Y'>0 D SED^DGPTFM2
..S Y=1
K DR,DIE,DIC,DA,DGI,DGJUMP,DGPRD,DLAYGO,RFL Q
REQ ;CHECK FOR REQUIRED FIELDS IN CPT RECORDS. RECORDS MISSING ONE OR MORE REQUIRED FIELDS ARE DELETED.
S RFL=0 I '$P(^DGPT(PTF,"C",PSIEN,0),U,3) S DA(1)=PTF,DA=DGPSM,DIK="^DGPT("_PTF_",""C""," D G REQQ
.D ^DIK K DA W !!,"No CPT records have been filed because no performing provider was specified." S RFL=1
S (I,FCPT)=0 D RESEQ^DGPTFM3(PTF)
F J=1:1 S I=$O(^DGCPT(46,"C",PTF,I)) Q:'I D:+^DGCPT(46,I,1)=DGPRD&'$G(^(9))
.I $P(^DGCPT(46,I,0),U,4) S FCPT=1 Q
.S DA=I,DIK="^DGCPT(46,",CPT=+^DGCPT(46,I,0) D ^DIK
.W !!,"CPT " S N=$$CPT^ICPTCOD(CPT,$$GETDATE^ICDGTDRG(PTF)) W $P(N,U,2)," ",$P(N,U,3)," not filed because no diagnosis 1 was entered."
.S RFL=2
I FCPT K FCPT,I,J,N G REQQ
S DA(1)=PTF,DA=PSIEN,DIK="^DGPT("_PTF_",""C"","
D ^DIK K DA W !!,"No CPT records have been filed because no CPT codes were filed." S RFL=1 K FCPT,I,J,N
REQQ ;D RESEQ^DGPTFM3(PTF)
Q
SED S DR=".14////"_DGPRD_";.16////"_PTF_";",DA=+Y,DIE="^DGCPT(46,"
S REC=PTF D SDR^DGPTFM21,FMDIE Q
PCE S DIR("A")="Send record to PCE? ",DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
D ^DIR K DIR Q:Y="N"!$D(DIRUT)
D MOB^DGPTFM2 S RES=$$DATA2PCE^DGAPI1(DFN,PTF,DGZP)
I RES=1 L -^DGPT(PTF) W !,"PTF Record sent to PCE" H 2 Q
W @IOF
;F I=1:1 Q:'$D(^TMP("DGPAPI",$J,"DIERR",$J,1,"TEXT",I)) W !,^(I)
W !,"The PTF Record may not have been filed in PCE due to errors."
W !,"Press return to continue." R X:DTIME
L -^DGPT(PTF) Q
FMDIE L +^DGPT(45,REC):2
I D ^DIE S RES=$$DELVFILE^DGAPI1(DFN,PTF,DGZP) L -^DGPT(45,REC) Q
ERR W !,"CPT record is being edited by another user" K DIE,REC S ERRFKG=1 H 2 Q
DGPTFQWK ;ALB/AS - QUICK/LOAD PTF DATA ;7/21/05 2:44pm
+1 ;;5.3;Registration;**517,594,635,729,1015**;Aug 13, 1993;Build 21
+2 ;
+3 SET (DGPTF,DA)=PTF
SET DIE="^DGPT("
SET DR="[DGQWK"_$SELECT('DGPTFE:"]",1:"F]")
WRITE !,"* editing 101 & 701 transactions"
DO ^DIE
SET DR="[DG701]"
DO ^DIE
WRITE !,"* editing 501 transactions"
+4 FOR DGM=0:0
DO S501
IF Y'>0
QUIT
KILL DA
SET (DGPTF,DA)=PTF
SET DGMOV=+Y
SET DGJUMP=$SELECT('DGPTFE:"",1:"1-2")
SET DR=$SELECT('DGPTFE:"[DG501]",1:"[DG501F]")
SET DIE="^DGPT("
DO ^DIE
DO CHK501^DGPTSCAN
KILL DGMOV
+5 KILL DIC,DA,DR,DIE
+6 WRITE !,"* editing 401 transactions"
+7 FOR DGM=0:0
DO S401
IF Y'>0
QUIT
KILL DA
SET DGSUR=+Y
SET DGJUMP="1-2"
SET DR="[DG401]"
SET DIE="^DGPT("
SET (DA,DGPTF)=PTF
DO ^DIE
DO CHK401^DGPTSCAN
KILL DGSUR
+8 IF '$PIECE(^DGPT(PTF,0),U,4)
WRITE !,"* editing 801 transactions"
DO S801
+9 KILL DIC,DA,DR,DIE
+10 WRITE !,"* editing 601 transactions"
+11 FOR DGM=0:0
SET DGZP=1
DO S601
IF Y'>0
QUIT
KILL DA
SET P(DGZP,1)=+Y
SET DGJUMP="1-2"
SET DR="[DG601]"
SET DIE="^DGPT("
SET (DA,DGPTF)=PTF
DO ^DIE
DO CHK601^DGPTSCAN
KILL P
+12 KILL DIC,DA,DR,DIE
+13 ;S DR="60",DR(2,45.05)=".01;2;S:'X Y=4;3;4:8",DIE="^DGPT(",DA=PTF D ^DIE
+14 IF '$PIECE(^DGPT(PTF,0),"^",4)&('DGST)
WRITE !," Updating TRANSFER DRGs"
SET DGADM=$PIECE(^DGPT(PTF,0),U,2)
DO SUDO1^DGPTSUDO
+15 KILL DGM,DA,DGMOVENO,DIC,DIE,DR,Y,DGPTF,DGJUMP
QUIT
S501 ;-- set up 501
+1 SET DA(1)=PTF
SET DIC("A")="Select 501 MOVEMENT NUMBER: "
SET DIC(0)="AEQ"
SET DIC="^DGPT("_PTF_",""M"","
IF '$DATA(^DGPT(PTF,"M",0))
SET ^(0)="^45.02AI^^"
DO ^DIC
+2 KILL DA,DIC
+3 QUIT
+4 ;
S401 ;-- set up 401
+1 SET DA(1)=PTF
SET DIC("A")="Select 401 SURGERY DATE: "
SET DIC(0)="AEQL"
SET DIC="^DGPT("_PTF_",""S"","
IF '$DATA(^DGPT(PTF,"S",0))
SET ^(0)="^45.01DA^^"
DO ^DIC
+2 KILL DA,DIC
+3 QUIT
+4 ;
S601 ;-- set up 601
+1 SET DA(1)=PTF
SET DIC("A")="Select 601 PROCEDURE DATE: "
SET DIC(0)="AEQL"
SET DIC="^DGPT("_PTF_",""P"","
IF '$DATA(^DGPT(PTF,"P",0))
SET ^(0)="^45.05DA^^"
DO ^DIC
+2 KILL DA,DIC
+3 QUIT
S801 ;-- set up 801
+1 FOR
Begin DoDot:1
+2 SET DIC("A")="Select 801 CPT DATE/TIME: "
+3 SET DA(1)=PTF
SET DIC(0)="AEQLZ"
SET DIC="^DGPT("_PTF_",""C"","
SET DLAYGO=45
+4 IF '$DATA(^DGPT(PTF,"C",0))
SET ^(0)="^45.06^^"
DO ^DIC
+5 KILL DA,DIC,PSIEN
IF Y'>0
QUIT
SET DGPRD=+Y(0)
SET DGPSM=+Y
DO MOB^DGPTFM2
IF $PIECE(DGZPRF,U,3)
FOR I=1:1:$PIECE(DGZPRF,U,3)
IF DGZPRF(I,0)=DGPSM
SET DGZP=I
+6 SET (DA(1),REC)=PTF
SET DIE="^DGPT("_PTF_",""C"","
SET (DA,PSIEN)=DGZPRF(DGZP,0)
SET DR=".02;.03;.05"
DO FMDIE
IF $DATA(Y)>9!$DATA(DTOUT)
SET Y=-1
QUIT
+7 SET DGI=0
SET DR=".01;"
DO CL^SDCO21(DFN,DGPRD,"",.SDCLY)
Begin DoDot:2
+8 FOR
SET DGI=$ORDER(^DGCPT(46,"C",PTF,DGI))
IF DGI'>0
QUIT
IF +^DGCPT(46,DGI,1)=+DGZPRF(DGZP)&'$DATA(^(9))
SET (DA,REC)=DGI
SET DR=".01;"
SET DIE="^DGCPT(46,"
DO GETINFO^DGPTFM21
+9 FOR
SET DA=PTF
SET DIC="^DGCPT(46,"
SET DIC(0)="AELQMZ"
SET DLAYGO=46
SET DIC("S")="D EN6^DGPTFJC I 'DGER"
DO ^DIC
KILL DIC
IF Y'>0
QUIT
DO SED^DGPTFM2
+10 SET Y=1
End DoDot:2
SET Y=1
End DoDot:1
IF $DATA(PSIEN)
DO REQ
IF $GET(RFL)=1!(Y<0)
QUIT
DO PCE
+11 KILL DR,DIE,DIC,DA,DGI,DGJUMP,DGPRD,DLAYGO,RFL
QUIT
REQ ;CHECK FOR REQUIRED FIELDS IN CPT RECORDS. RECORDS MISSING ONE OR MORE REQUIRED FIELDS ARE DELETED.
+1 SET RFL=0
IF '$PIECE(^DGPT(PTF,"C",PSIEN,0),U,3)
SET DA(1)=PTF
SET DA=DGPSM
SET DIK="^DGPT("_PTF_",""C"","
Begin DoDot:1
+2 DO ^DIK
KILL DA
WRITE !!,"No CPT records have been filed because no performing provider was specified."
SET RFL=1
End DoDot:1
GOTO REQQ
+3 SET (I,FCPT)=0
DO RESEQ^DGPTFM3(PTF)
+4 FOR J=1:1
SET I=$ORDER(^DGCPT(46,"C",PTF,I))
IF 'I
QUIT
IF +^DGCPT(46,I,1)=DGPRD&'$GET(^(9))
Begin DoDot:1
+5 IF $PIECE(^DGCPT(46,I,0),U,4)
SET FCPT=1
QUIT
+6 SET DA=I
SET DIK="^DGCPT(46,"
SET CPT=+^DGCPT(46,I,0)
DO ^DIK
+7 WRITE !!,"CPT "
SET N=$$CPT^ICPTCOD(CPT,$$GETDATE^ICDGTDRG(PTF))
WRITE $PIECE(N,U,2)," ",$PIECE(N,U,3)," not filed because no diagnosis 1 was entered."
+8 SET RFL=2
End DoDot:1
+9 IF FCPT
KILL FCPT,I,J,N
GOTO REQQ
+10 SET DA(1)=PTF
SET DA=PSIEN
SET DIK="^DGPT("_PTF_",""C"","
+11 DO ^DIK
KILL DA
WRITE !!,"No CPT records have been filed because no CPT codes were filed."
SET RFL=1
KILL FCPT,I,J,N
REQQ ;D RESEQ^DGPTFM3(PTF)
+1 QUIT
SED SET DR=".14////"_DGPRD_";.16////"_PTF_";"
SET DA=+Y
SET DIE="^DGCPT(46,"
+1 SET REC=PTF
DO SDR^DGPTFM21
DO FMDIE
QUIT
PCE SET DIR("A")="Send record to PCE? "
SET DIR(0)="S^Y:YES;N:NO"
SET DIR("B")="NO"
+1 DO ^DIR
KILL DIR
IF Y="N"!$DATA(DIRUT)
QUIT
+2 DO MOB^DGPTFM2
SET RES=$$DATA2PCE^DGAPI1(DFN,PTF,DGZP)
+3 IF RES=1
LOCK -^DGPT(PTF)
WRITE !,"PTF Record sent to PCE"
HANG 2
QUIT
+4 WRITE @IOF
+5 ;F I=1:1 Q:'$D(^TMP("DGPAPI",$J,"DIERR",$J,1,"TEXT",I)) W !,^(I)
+6 WRITE !,"The PTF Record may not have been filed in PCE due to errors."
+7 WRITE !,"Press return to continue."
READ X:DTIME
+8 LOCK -^DGPT(PTF)
QUIT
FMDIE LOCK +^DGPT(45,REC):2
+1 IF $TEST
DO ^DIE
SET RES=$$DELVFILE^DGAPI1(DFN,PTF,DGZP)
LOCK -^DGPT(45,REC)
QUIT
ERR WRITE !,"CPT record is being edited by another user"
KILL DIE,REC
SET ERRFKG=1
HANG 2
QUIT
