- 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 Feb 19, 2025@00:07:31 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
