DGAPI ;WASH/DWS - PTF's APIs ;7/29/04 7:33am
;;5.3;Registration;**517,594,664**;Aug 13, 1993;Build 15
Q
;
DATA2PTF(DFN,PTF,PSDATE,USER,FLAG,SOURCE) ;API to pass data for add/edit/delete to PTF
I $G(PTF) Q:'$D(^DGPT(PTF)) -2
I '$G(PTF) Q:'$G(PSDATE) -2 D FIND Q:'$G(PTF) -2
I $P($G(^DGPT(PTF,0)),U,6) S ERR="INPATIENT STAY CLOSED, THE PTF SYSTEM CAN BE USED TO RE-OPEN IT." D Q -1
.I +$G(FLAG) W !,ERR Q
.S ^TMP("PTF",$J,"DIERR")=ERR
Q:'$D(^TMP("PTF",$J)) -3 S FL=0 D PROV I $G(Y)'>0!FL K FL,Y Q -1
K ERR,FL Q PTF
CPTINFO(DFN,PTF,PSDATE) ;API to get CPT data from PTF
I '$G(PTF) Q:'$G(PSDATE) D FIND Q:'$G(PTF)
S I=0 F S I=$O(^DGPT(PTF,"C",I)) Q:I'>0 I +^(I,0)=PSDATE S ^TMP("PTF",$J,46,0)=$P(^(0),U,2,5),(K,K1)=0 D Q
.F S K=$O(^DGCPT(46,"C",PTF,K)) Q:K'>0 I PSDATE=+$G(^DGCPT(46,K,1)),'$G(^(9)) S K1=K1+1,^TMP("PTF",$J,46,K1)=K_U_^(0)
K I,K,K1 Q
PTFINFOR(DFN,PTF,PSDATE) ;API to get a list of CPT records from PTF
I '$G(PTF) Q:'$G(PSDATE) D FIND Q:'$G(PTF)
S I=0 F I1=1:1 S I=$O(^DGPT(PTF,"C",I)) Q:I'>0 S ^TMP("PTF",$J,I1)=^(I,0)
K I,I1 Q
DELCPT(DA) ;API to delete cpt code from PTF
S PTF=$P($G(^DGCPT(46,DA,1)),U,3) I $P(^DGPT(PTF,0),U,6) K PTF Q -1
S REC=DA,DIE="^DGCPT(46,",DR="1////^S X=%" L +^DGCPT(46,REC):2 I D NOW^%DTC,^DIE K DIE,DR L -^DGCPT(46,REC) K REC Q 1
K REC Q -1
DELPOV(DA) ;API to delete a diagnosis from PTF
S PTF=+$G(^DGICD9(46.1,DA,1)) I $P(^DGPT(PTF,0),U,6) Q -1
S REC=DA,DIE="^DGICD9(46.1,",DR="9////^S X=%" L +^DGCPT(46.1,REC):2 I D NOW^%DTC,^DIE K DIE,DR L -^DGCPT(46.1,REC) K REC Q 1
K REC Q -1
ICDINFO(DFN,PTF,PSDATE,DGI) ;API to get Diagnosis data from PTF
I '$G(PTF),'$G(DGI) Q:'$G(PSDATE) D FIND Q:'$G(PTF)
I $G(PTF) S I=0 F I1=1:1 S I=$O(^DGICD9(46.1,"C",PTF,I)) Q:I'>0 I '$G(^DGICD9(46.1,I,9)) S ^TMP("PTF",$J,46.1,I1)=I_U_^DGICD9(46.1,I,0)
I '$G(PTF),$G(DGI) S ^TMP("PTF",$J,46.1,1)=DGI_U_$G(^DGICD9(46.1,DGI,0))
K I,I1 Q
FIND ;Find the IEN for the PTF file
S (I,K)=0 F S I=$O(^DGPT("B",DFN,I)) Q:'I I $P(^DGPT(I,0),U,11)=1 S J=$G(^DGPT(I,70)) I J'<PSDATE!'J S L=$P(^(0),"^",2) I L'>PSDATE D
.Q:L<K S PTF=I,K=L
K I,J,K,L Q
PROV ;FILE PROVIDERS AND CPT CODES
N DGI,LOC
I $D(^TMP("PTF",$J,46,0)) S:'$D(^DGPT(PTF,"C",0)) ^(0)="^45.06D^^" D
.S DIC="^DGPT("_PTF_",""C"",",DIC(0)="LMZ",DA(1)=PTF,DLAYGO=45,X=PSDATE D ^DIC K DIC,DLAYGO,X I Y'>0 Q
.S DA(1)=PTF,DIE="^DGPT("_PTF_",""C"",",(DA,REC)=+Y,DR="",I=^TMP("PTF",$J,46,0)
.S REFPROV=+I,PERFPROV=$P(I,U,2) S:REFPROV DR=DR_".02////^S X=REFPROV;" S DR=DR_".03////^S X=PERFPROV;"
.S DIAG=$P(I,U,3),LOC=$P(I,U,4) K I S DR=DR_".04////^S X=DIAG;" S:LOC DR=DR_".05////^S X=LOC;"
.L +^DGPT(REC):2 I '$T D ERR(46,"CPT entry is being edited by another user") K DIE,DR,REC Q
.D ^DIE L -^DGPT(REC) K DIE,DR,REFPROV,PERFPROV,REC S DGI=0 F S DGI=$O(^TMP("PTF",$J,46,DGI)) Q:'DGI D CPT
S DGI=0 F S DGI=$O(^TMP("PTF",$J,46.1,DGI)) Q:'DGI D DIAG
S Y=1 Q
CPT ;FILE CPT INFORMATION IN ^DGCPT
S DGJ=0,STR=^TMP("PTF",$J,46,DGI),DLAYGO=46
I STR S Y=+STR G CPTFL ;if rec num in DGCPT is passed, overlay without any verification of CPT code passed
F S DGJ=$O(^DGCPT(46,"C",PTF,DGJ)) Q:DGJ'>0 I +^DGCPT(46,DGJ,1)=PSDATE,$P(^(0),U)=$P(STR,U,2),'$D(^(9)) S STR=DGJ_STR,Y=DGJ,^TMP("PTF",$J,46,DGI)=STR Q
I 'STR K DO S DIC="^DGCPT(46,",DIC(0)="F",X=$P(STR,U,2) D FILE^DICN K DIC,X Q:Y'>0 S STR=+Y_STR,^TMP("PTF",$J,46,DGI)=STR
CPTFL S Y=+Y_"," F I=1:1:13 S CPT(46,Y,I/100)=$P(STR,U,I+1)
F I=20:1:24 S CPT(46,Y,I/100)=$P(STR,U,I-5)
S CPT(46,Y,.14)=PSDATE,CPT(46,Y,.16)=PTF
S CPT(46,Y,.17)=$G(SOURCE),CPT(46,Y,.18)=$G(USER)
D FILE^DIE("K","CPT","^TMP(""PTF"",$J,46,DGI)")
I $D(^TMP("PTF",$J,46,DGI,"DIERR")) S FL=1 I +$G(FLAG),$D(^("DIERR",1,"TEXT",1)) W !,^(1)
K STR,CPT,DGJ,I Q
DIAG ;FILE DIAGNOSIS INFORMATION IN ^DGCPT
S DGJ=0,STR=^TMP("PTF",$J,46.1,DGI),DLAYGO=46.1
I STR S Y=+STR G DIAGFL ;if rec num in DGICD9 is passed, overlay without any verification of DGN code passed
F S DGJ=$O(^DGICD9(46.1,"C",PTF,DGJ)) Q:DGJ'>0 I $P(^DGICD9(46.1,DGJ,0),U)=$P(STR,U,2),'$G(^(9)) S STR=DGJ_STR,Y=DGJ,^TMP("PTF",$J,46.1,DGI)=STR Q
I 'STR K DO S DIC="^DGICD9(46.1,",DIC(0)="F",X=$P(STR,U,2) D FILE^DICN K DIC,X Q:Y'>0 S STR=+Y_STR,^TMP("PTF",$J,46.1,DGI)=STR
DIAGFL S Y=+Y_"," F I=1:1:9 S DIAG(46.1,Y,I/100)=$P(STR,U,I+1)
S DIAG(46.1,Y,1.1)=$G(SOURCE),DIAG(46.1,Y,1.2)=$G(USER)
S DIAG(46.1,Y,1)=PTF D FILE^DIE("K","DIAG","^TMP(""PTF"",$J,46.1,DGI)")
I $D(^TMP("PTF",$J,46.1,DGI,"DIERR")) S FL=1 I +$G(FLAG),$D(^("DIERR",1,"TEXT",1)) W !,^(1)
K STR,CPT,DGJ,DIAG,I Q
ERR(FILE,MESS) ;DISPLAY OR PRINT ERROR MESSAGES BASED ON FLAG PARAMETER FOR DATA2PTF
S FL=1 I +$G(FLAG) W !,MESS Q
S ^TMP("PTF",$J,FILE,DGI,"DIERR")=MESS Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGAPI 4729 printed Apr 09, 2024@21:53:46 Page 2
DGAPI ;WASH/DWS - PTF's APIs ;7/29/04 7:33am
+1 ;;5.3;Registration;**517,594,664**;Aug 13, 1993;Build 15
+2 QUIT
+3 ;
DATA2PTF(DFN,PTF,PSDATE,USER,FLAG,SOURCE) ;API to pass data for add/edit/delete to PTF
+1 IF $GET(PTF)
if '$DATA(^DGPT(PTF))
QUIT -2
+2 IF '$GET(PTF)
if '$GET(PSDATE)
QUIT -2
DO FIND
if '$GET(PTF)
QUIT -2
+3 IF $PIECE($GET(^DGPT(PTF,0)),U,6)
SET ERR="INPATIENT STAY CLOSED, THE PTF SYSTEM CAN BE USED TO RE-OPEN IT."
Begin DoDot:1
+4 IF +$GET(FLAG)
WRITE !,ERR
QUIT
+5 SET ^TMP("PTF",$JOB,"DIERR")=ERR
End DoDot:1
QUIT -1
+6 if '$DATA(^TMP("PTF",$JOB))
QUIT -3
SET FL=0
DO PROV
IF $GET(Y)'>0!FL
KILL FL,Y
QUIT -1
+7 KILL ERR,FL
QUIT PTF
CPTINFO(DFN,PTF,PSDATE) ;API to get CPT data from PTF
+1 IF '$GET(PTF)
if '$GET(PSDATE)
QUIT
DO FIND
if '$GET(PTF)
QUIT
+2 SET I=0
FOR
SET I=$ORDER(^DGPT(PTF,"C",I))
if I'>0
QUIT
IF +^(I,0)=PSDATE
SET ^TMP("PTF",$JOB,46,0)=$PIECE(^(0),U,2,5)
SET (K,K1)=0
Begin DoDot:1
+3 FOR
SET K=$ORDER(^DGCPT(46,"C",PTF,K))
if K'>0
QUIT
IF PSDATE=+$GET(^DGCPT(46,K,1))
IF '$GET(^(9))
SET K1=K1+1
SET ^TMP("PTF",$JOB,46,K1)=K_U_^(0)
End DoDot:1
QUIT
+4 KILL I,K,K1
QUIT
PTFINFOR(DFN,PTF,PSDATE) ;API to get a list of CPT records from PTF
+1 IF '$GET(PTF)
if '$GET(PSDATE)
QUIT
DO FIND
if '$GET(PTF)
QUIT
+2 SET I=0
FOR I1=1:1
SET I=$ORDER(^DGPT(PTF,"C",I))
if I'>0
QUIT
SET ^TMP("PTF",$JOB,I1)=^(I,0)
+3 KILL I,I1
QUIT
DELCPT(DA) ;API to delete cpt code from PTF
+1 SET PTF=$PIECE($GET(^DGCPT(46,DA,1)),U,3)
IF $PIECE(^DGPT(PTF,0),U,6)
KILL PTF
QUIT -1
+2 SET REC=DA
SET DIE="^DGCPT(46,"
SET DR="1////^S X=%"
LOCK +^DGCPT(46,REC):2
IF $TEST
DO NOW^%DTC
DO ^DIE
KILL DIE,DR
LOCK -^DGCPT(46,REC)
KILL REC
QUIT 1
+3 KILL REC
QUIT -1
DELPOV(DA) ;API to delete a diagnosis from PTF
+1 SET PTF=+$GET(^DGICD9(46.1,DA,1))
IF $PIECE(^DGPT(PTF,0),U,6)
QUIT -1
+2 SET REC=DA
SET DIE="^DGICD9(46.1,"
SET DR="9////^S X=%"
LOCK +^DGCPT(46.1,REC):2
IF $TEST
DO NOW^%DTC
DO ^DIE
KILL DIE,DR
LOCK -^DGCPT(46.1,REC)
KILL REC
QUIT 1
+3 KILL REC
QUIT -1
ICDINFO(DFN,PTF,PSDATE,DGI) ;API to get Diagnosis data from PTF
+1 IF '$GET(PTF)
IF '$GET(DGI)
if '$GET(PSDATE)
QUIT
DO FIND
if '$GET(PTF)
QUIT
+2 IF $GET(PTF)
SET I=0
FOR I1=1:1
SET I=$ORDER(^DGICD9(46.1,"C",PTF,I))
if I'>0
QUIT
IF '$GET(^DGICD9(46.1,I,9))
SET ^TMP("PTF",$JOB,46.1,I1)=I_U_^DGICD9(46.1,I,0)
+3 IF '$GET(PTF)
IF $GET(DGI)
SET ^TMP("PTF",$JOB,46.1,1)=DGI_U_$GET(^DGICD9(46.1,DGI,0))
+4 KILL I,I1
QUIT
FIND ;Find the IEN for the PTF file
+1 SET (I,K)=0
FOR
SET I=$ORDER(^DGPT("B",DFN,I))
if 'I
QUIT
IF $PIECE(^DGPT(I,0),U,11)=1
SET J=$GET(^DGPT(I,70))
IF J'<PSDATE!'J
SET L=$PIECE(^(0),"^",2)
IF L'>PSDATE
Begin DoDot:1
+2 if L<K
QUIT
SET PTF=I
SET K=L
End DoDot:1
+3 KILL I,J,K,L
QUIT
PROV ;FILE PROVIDERS AND CPT CODES
+1 NEW DGI,LOC
+2 IF $DATA(^TMP("PTF",$JOB,46,0))
if '$DATA(^DGPT(PTF,"C",0))
SET ^(0)="^45.06D^^"
Begin DoDot:1
+3 SET DIC="^DGPT("_PTF_",""C"","
SET DIC(0)="LMZ"
SET DA(1)=PTF
SET DLAYGO=45
SET X=PSDATE
DO ^DIC
KILL DIC,DLAYGO,X
IF Y'>0
QUIT
+4 SET DA(1)=PTF
SET DIE="^DGPT("_PTF_",""C"","
SET (DA,REC)=+Y
SET DR=""
SET I=^TMP("PTF",$JOB,46,0)
+5 SET REFPROV=+I
SET PERFPROV=$PIECE(I,U,2)
if REFPROV
SET DR=DR_".02////^S X=REFPROV;"
SET DR=DR_".03////^S X=PERFPROV;"
+6 SET DIAG=$PIECE(I,U,3)
SET LOC=$PIECE(I,U,4)
KILL I
SET DR=DR_".04////^S X=DIAG;"
if LOC
SET DR=DR_".05////^S X=LOC;"
+7 LOCK +^DGPT(REC):2
IF '$TEST
DO ERR(46,"CPT entry is being edited by another user")
KILL DIE,DR,REC
QUIT
+8 DO ^DIE
LOCK -^DGPT(REC)
KILL DIE,DR,REFPROV,PERFPROV,REC
SET DGI=0
FOR
SET DGI=$ORDER(^TMP("PTF",$JOB,46,DGI))
if 'DGI
QUIT
DO CPT
End DoDot:1
+9 SET DGI=0
FOR
SET DGI=$ORDER(^TMP("PTF",$JOB,46.1,DGI))
if 'DGI
QUIT
DO DIAG
+10 SET Y=1
QUIT
CPT ;FILE CPT INFORMATION IN ^DGCPT
+1 SET DGJ=0
SET STR=^TMP("PTF",$JOB,46,DGI)
SET DLAYGO=46
+2 ;if rec num in DGCPT is passed, overlay without any verification of CPT code passed
IF STR
SET Y=+STR
GOTO CPTFL
+3 FOR
SET DGJ=$ORDER(^DGCPT(46,"C",PTF,DGJ))
if DGJ'>0
QUIT
IF +^DGCPT(46,DGJ,1)=PSDATE
IF $PIECE(^(0),U)=$PIECE(STR,U,2)
IF '$DATA(^(9))
SET STR=DGJ_STR
SET Y=DGJ
SET ^TMP("PTF",$JOB,46,DGI)=STR
QUIT
+4 IF 'STR
KILL DO
SET DIC="^DGCPT(46,"
SET DIC(0)="F"
SET X=$PIECE(STR,U,2)
DO FILE^DICN
KILL DIC,X
if Y'>0
QUIT
SET STR=+Y_STR
SET ^TMP("PTF",$JOB,46,DGI)=STR
CPTFL SET Y=+Y_","
FOR I=1:1:13
SET CPT(46,Y,I/100)=$PIECE(STR,U,I+1)
+1 FOR I=20:1:24
SET CPT(46,Y,I/100)=$PIECE(STR,U,I-5)
+2 SET CPT(46,Y,.14)=PSDATE
SET CPT(46,Y,.16)=PTF
+3 SET CPT(46,Y,.17)=$GET(SOURCE)
SET CPT(46,Y,.18)=$GET(USER)
+4 DO FILE^DIE("K","CPT","^TMP(""PTF"",$J,46,DGI)")
+5 IF $DATA(^TMP("PTF",$JOB,46,DGI,"DIERR"))
SET FL=1
IF +$GET(FLAG)
IF $DATA(^("DIERR",1,"TEXT",1))
WRITE !,^(1)
+6 KILL STR,CPT,DGJ,I
QUIT
DIAG ;FILE DIAGNOSIS INFORMATION IN ^DGCPT
+1 SET DGJ=0
SET STR=^TMP("PTF",$JOB,46.1,DGI)
SET DLAYGO=46.1
+2 ;if rec num in DGICD9 is passed, overlay without any verification of DGN code passed
IF STR
SET Y=+STR
GOTO DIAGFL
+3 FOR
SET DGJ=$ORDER(^DGICD9(46.1,"C",PTF,DGJ))
if DGJ'>0
QUIT
IF $PIECE(^DGICD9(46.1,DGJ,0),U)=$PIECE(STR,U,2)
IF '$GET(^(9))
SET STR=DGJ_STR
SET Y=DGJ
SET ^TMP("PTF",$JOB,46.1,DGI)=STR
QUIT
+4 IF 'STR
KILL DO
SET DIC="^DGICD9(46.1,"
SET DIC(0)="F"
SET X=$PIECE(STR,U,2)
DO FILE^DICN
KILL DIC,X
if Y'>0
QUIT
SET STR=+Y_STR
SET ^TMP("PTF",$JOB,46.1,DGI)=STR
DIAGFL SET Y=+Y_","
FOR I=1:1:9
SET DIAG(46.1,Y,I/100)=$PIECE(STR,U,I+1)
+1 SET DIAG(46.1,Y,1.1)=$GET(SOURCE)
SET DIAG(46.1,Y,1.2)=$GET(USER)
+2 SET DIAG(46.1,Y,1)=PTF
DO FILE^DIE("K","DIAG","^TMP(""PTF"",$J,46.1,DGI)")
+3 IF $DATA(^TMP("PTF",$JOB,46.1,DGI,"DIERR"))
SET FL=1
IF +$GET(FLAG)
IF $DATA(^("DIERR",1,"TEXT",1))
WRITE !,^(1)
+4 KILL STR,CPT,DGJ,DIAG,I
QUIT
ERR(FILE,MESS) ;DISPLAY OR PRINT ERROR MESSAGES BASED ON FLAG PARAMETER FOR DATA2PTF
+1 SET FL=1
IF +$GET(FLAG)
WRITE !,MESS
QUIT
+2 SET ^TMP("PTF",$JOB,FILE,DGI,"DIERR")=MESS
QUIT
