DGAPI1 ;ALB/DWS - DG API TO COMUNICATE WITH PCE ;6/16/05 1:44pm
;;5.3;Registration;**635,664**;Aug 13, 1993;Build 15
DATA2PCE(DFN,PTF,DGZP) ;SEND CPT PROCEDURE TRANSACTIONS TO PCE
;
N DGVISIT,DR,DIE,DA,X,Y
;
D BUILD
;
I $P($G(DGZPRF(DGZP)),U,6) S DGVISIT=$P(DGZPRF(DGZP),U,6)
;
I $D(DGREL) S DGRELSV=DGREL ;save DGREL, it gets killed off in SCDXMSG1
S RES=$$DATA2PCE^PXAPI("^TMP(""DGPCE1"",$J,""PXAPI"")",107,"801 SCREEN",.DGVISIT)
I $D(DGRELSV) S DGREL=DGRELSV K DGRELSV ;restore DGREL
;
D:$D(^TMP("DGPCE1",$J,"PXAPI","DIERR")) ERR
;
K ^TMP("DGPCE1",$J,"PXAPI")
;
;
Q:RES<-1 RES
;
S DR=".06////"_DGVISIT_";.07////1",DIE="^DGPT("_PTF_",""C"",",DA=DGZPRF(DGZP,0),DA(1)=PTF D ^DIE
;
Q RES
;
ERR ; looks to see if there is an trully an error
N DGX,DGQ
S (DGQ,DGX)=0 F S DGX=$O(^TMP("DGPCE1",$J,"PXAPI","DIERR",$J,DGX)) Q:'DGX!(DGQ) I $E($G(^TMP("DGPCE1",$J,"PXAPI","DIERR",$J,DGX,"TEXT",1)),1,5)="ERROR" S DGQ=1 D ERRMSG(DGX)
Q
;
ERRMSG(DGX) ; sends the error message
N XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG,DGL,DGTXT,DGY
;
D DEM^VADPT
;
S XMDUZ="PTF MODULE",XMSUB="801 to PCE filing error"
S XMY("G.DG PTF 801 TO PCE ERROR")="",XMY(DUZ)="",XMTEXT="DGTXT("
;
S DGTXT(1,0)="An error has occured while sending PTF 801 data to PCE."
S DGTXT(2,0)=" "
S DGTXT(3,0)=" Patient Name: "_VADM(1)
S DGTXT(4,0)=" Social Security: "_$P(VADM(2),"^",2)
S DGTXT(5,0)=" Date/Time: "_$$FMTE^XLFDT(+DGZPRF(DGZP))
S DGTXT(6,0)=" Location: "_$P($G(^SC($P(DGZPRF(DGZP),"^",5),0)),"^")
S DGTXT(7,0)=" "
;
S DGL=7,DGY=0 F S DGY=$O(^TMP("DGPCE1",$J,"PXAPI","DIERR",$J,DGX,"TEXT",DGY)) Q:'DGY!($E(^TMP("DGPCE1",$J,"PXAPI","DIERR",$J,DGX,"TEXT",DGY),1,25)="^TMP(""DGPCE1"",$J,""PXAPI"")") D
. S DGL=DGL+1,DGTXT(DGL,0)=" "_^TMP("DGPCE1",$J,"PXAPI","DIERR",$J,DGX,"TEXT",DGY)
;
D ^XMD
D KVAR^VADPT
;
Q
;
DELVFILE(DFN,PTF,DGZP) ;DELETE VISIT IN PCE WHEN A CHANGE IS MADE
N DIE,DA,DR S RES=1
S:$P(DGZPRF(DGZP),U,7) RES=$$DELVFILE^PXAPI("ALL",$P(DGZPRF(DGZP),U,6))
S DA=DGZPRF(DGZP,0),DA(1)=PTF
S DIE="^DGPT("_PTF_",""C"",",DR=".06///@;.07////0" D ^DIE
Q RES
;
BUILD ; now build array for passing data to PCE
N DGAPI,DGC,DGPROC,DGPROCZ,DGP,DGDXNO,DGDXC,DGDX,DGX
K ^TMP("DGPCE1",$J,"PXAPI") S DGDXC=0
S DGAPI=$NA(^TMP("DGPCE1",$J,"PXAPI"))
; ---------encounter date/time----------------
S @DGAPI@("ENCOUNTER",1,"ENC D/T")=+DGZPRF(DGZP)
; --------------patient-----------------------
S @DGAPI@("ENCOUNTER",1,"PATIENT")=DFN
; ---------------location---------------------
S @DGAPI@("ENCOUNTER",1,"HOS LOC")=$P(DGZPRF(DGZP),"^",5)
; --------------service category--------------
S @DGAPI@("ENCOUNTER",1,"SERVICE CATEGORY")="I"
; ---------------encounter type---------------
S @DGAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
; ------------primary provider----------------
S @DGAPI@("PROVIDER",1,"NAME")=$P(DGZPRF(DGZP),"^",3)
S @DGAPI@("PROVIDER",1,"PRIMARY")=1
; ------------secondary provider-------------
I $P(DGZPRF(DGZP),"^",2),$P(DGZPRF(DGZP),"^",2)'=$P(DGZPRF(DGZP),"^",3) S @DGAPI@("PROVIDER",2,"NAME")=$P(DGZPRF(DGZP),"^",2)
; ----------------procedures-----------------
S DGC=0,DGPROC=0 F S DGPROC=$O(DGZPRF(DGZP,DGPROC)) Q:'DGPROC D
. S DGPROCZ=$G(DGZPRF(DGZP,DGPROC)) Q:'DGPROCZ
. S DGC=DGC+1,@DGAPI@("PROCEDURE",DGC,"PROCEDURE")=+DGPROCZ
. ; --------------modifiers------------------
. F DGP=2,3 I $P(DGPROCZ,"^",DGP) S @DGAPI@("PROCEDURE",DGC,"MODIFIERS",$P($$MOD^ICPTMOD($P(DGPROCZ,"^",DGP),"I",+DGZPRF(DGZP)),"^",2))=""
. ; --------------quantity-------------------
. S @DGAPI@("PROCEDURE",DGC,"QTY")=$P(DGPROCZ,"^",14)
. ; --------------diagnosis------------------
. F DGP=4:1:7,15:1:18 I $P(DGPROCZ,"^",DGP) D
. . S DGDXNO=$S(DGP=4:"",DGP<15:DGP-3,1:DGP-11)
. . S @DGAPI@("PROCEDURE",DGC,"DIAGNOSIS"_$S(DGDXNO<2:"",1:" "_DGDXNO))=$P(DGPROCZ,"^",DGP)
. . I $D(DGDX($P(DGPROCZ,"^",DGP))) Q
. . S DGDX($P(DGPROCZ,"^",DGP))="",DGDXC=DGDXC+1
. . S @DGAPI@("DX/PL",DGDXC,"DIAGNOSIS")=$P(DGPROCZ,"^",DGP)
. . S:DGDXC=1 @DGAPI@("DX/PL",DGDXC,"PRIMARY")=1
. . S (DGY,DGX)=0 F S DGX=$O(^DGICD9(46.1,"C",PTF,DGX)) Q:'DGX!(DGY) I +$G(^DGICD9(46.1,DGX,0))=$P(DGPROCZ,"^",DGP) S DGY=DGX
. . S DGY=$G(^DGICD9(46.1,+DGY,0))
. . I $L($P(DGY,"^",2)) S @DGAPI@("DX/PL",DGDXC,"PL SC")=$P(DGY,"^",2)
. . I $L($P(DGY,"^",3)) S @DGAPI@("DX/PL",DGDXC,"PL AO")=$P(DGY,"^",3)
. . I $L($P(DGY,"^",4)) S @DGAPI@("DX/PL",DGDXC,"PL IR")=$P(DGY,"^",4)
. . I $L($P(DGY,"^",5)) S @DGAPI@("DX/PL",DGDXC,"PL EC")=$P(DGY,"^",5)
. . I $L($P(DGY,"^",6)) S @DGAPI@("DX/PL",DGDXC,"PL MST")=$P(DGY,"^",6)
. . I $L($P(DGY,"^",7)) S @DGAPI@("DX/PL",DGDXC,"PL HNC")=$P(DGY,"^",7)
. . I $L($P(DGY,"^",8)) S @DGAPI@("DX/PL",DGDXC,"PL CV")=$P(DGY,"^",8)
. . I $L($P(DGY,"^",9)) S @DGAPI@("DX/PL",DGDXC,"PL SHAD")=$P(DGY,"^",9)
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGAPI1 4896 printed Sep 23, 2025@20:17:20 Page 2
DGAPI1 ;ALB/DWS - DG API TO COMUNICATE WITH PCE ;6/16/05 1:44pm
+1 ;;5.3;Registration;**635,664**;Aug 13, 1993;Build 15
DATA2PCE(DFN,PTF,DGZP) ;SEND CPT PROCEDURE TRANSACTIONS TO PCE
+1 ;
+2 NEW DGVISIT,DR,DIE,DA,X,Y
+3 ;
+4 DO BUILD
+5 ;
+6 IF $PIECE($GET(DGZPRF(DGZP)),U,6)
SET DGVISIT=$PIECE(DGZPRF(DGZP),U,6)
+7 ;
+8 ;save DGREL, it gets killed off in SCDXMSG1
IF $DATA(DGREL)
SET DGRELSV=DGREL
+9 SET RES=$$DATA2PCE^PXAPI("^TMP(""DGPCE1"",$J,""PXAPI"")",107,"801 SCREEN",.DGVISIT)
+10 ;restore DGREL
IF $DATA(DGRELSV)
SET DGREL=DGRELSV
KILL DGRELSV
+11 ;
+12 if $DATA(^TMP("DGPCE1",$JOB,"PXAPI","DIERR"))
DO ERR
+13 ;
+14 KILL ^TMP("DGPCE1",$JOB,"PXAPI")
+15 ;
+16 ;
+17 if RES<-1
QUIT RES
+18 ;
+19 SET DR=".06////"_DGVISIT_";.07////1"
SET DIE="^DGPT("_PTF_",""C"","
SET DA=DGZPRF(DGZP,0)
SET DA(1)=PTF
DO ^DIE
+20 ;
+21 QUIT RES
+22 ;
ERR ; looks to see if there is an trully an error
+1 NEW DGX,DGQ
+2 SET (DGQ,DGX)=0
FOR
SET DGX=$ORDER(^TMP("DGPCE1",$JOB,"PXAPI","DIERR",$JOB,DGX))
if 'DGX!(DGQ)
QUIT
IF $EXTRACT($GET(^TMP("DGPCE1",$JOB,"PXAPI","DIERR",$JOB,DGX,"TEXT",1)),1,5)="ERROR"
SET DGQ=1
DO ERRMSG(DGX)
+3 QUIT
+4 ;
ERRMSG(DGX) ; sends the error message
+1 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG,DGL,DGTXT,DGY
+2 ;
+3 DO DEM^VADPT
+4 ;
+5 SET XMDUZ="PTF MODULE"
SET XMSUB="801 to PCE filing error"
+6 SET XMY("G.DG PTF 801 TO PCE ERROR")=""
SET XMY(DUZ)=""
SET XMTEXT="DGTXT("
+7 ;
+8 SET DGTXT(1,0)="An error has occured while sending PTF 801 data to PCE."
+9 SET DGTXT(2,0)=" "
+10 SET DGTXT(3,0)=" Patient Name: "_VADM(1)
+11 SET DGTXT(4,0)=" Social Security: "_$PIECE(VADM(2),"^",2)
+12 SET DGTXT(5,0)=" Date/Time: "_$$FMTE^XLFDT(+DGZPRF(DGZP))
+13 SET DGTXT(6,0)=" Location: "_$PIECE($GET(^SC($PIECE(DGZPRF(DGZP),"^",5),0)),"^")
+14 SET DGTXT(7,0)=" "
+15 ;
+16 SET DGL=7
SET DGY=0
FOR
SET DGY=$ORDER(^TMP("DGPCE1",$JOB,"PXAPI","DIERR",$JOB,DGX,"TEXT",DGY))
if 'DGY!($EXTRACT(^TMP("DGPCE1",$JOB,"PXAPI","DIERR",$JOB,DGX,"TEXT",DGY),1,25)="^TMP(""DGPCE1"",$J,""PXAPI"")")
QUIT
Begin DoDot:1
+17 SET DGL=DGL+1
SET DGTXT(DGL,0)=" "_^TMP("DGPCE1",$JOB,"PXAPI","DIERR",$JOB,DGX,"TEXT",DGY)
End DoDot:1
+18 ;
+19 DO ^XMD
+20 DO KVAR^VADPT
+21 ;
+22 QUIT
+23 ;
DELVFILE(DFN,PTF,DGZP) ;DELETE VISIT IN PCE WHEN A CHANGE IS MADE
+1 NEW DIE,DA,DR
SET RES=1
+2 if $PIECE(DGZPRF(DGZP),U,7)
SET RES=$$DELVFILE^PXAPI("ALL",$PIECE(DGZPRF(DGZP),U,6))
+3 SET DA=DGZPRF(DGZP,0)
SET DA(1)=PTF
+4 SET DIE="^DGPT("_PTF_",""C"","
SET DR=".06///@;.07////0"
DO ^DIE
+5 QUIT RES
+6 ;
BUILD ; now build array for passing data to PCE
+1 NEW DGAPI,DGC,DGPROC,DGPROCZ,DGP,DGDXNO,DGDXC,DGDX,DGX
+2 KILL ^TMP("DGPCE1",$JOB,"PXAPI")
SET DGDXC=0
+3 SET DGAPI=$NAME(^TMP("DGPCE1",$JOB,"PXAPI"))
+4 ; ---------encounter date/time----------------
+5 SET @DGAPI@("ENCOUNTER",1,"ENC D/T")=+DGZPRF(DGZP)
+6 ; --------------patient-----------------------
+7 SET @DGAPI@("ENCOUNTER",1,"PATIENT")=DFN
+8 ; ---------------location---------------------
+9 SET @DGAPI@("ENCOUNTER",1,"HOS LOC")=$PIECE(DGZPRF(DGZP),"^",5)
+10 ; --------------service category--------------
+11 SET @DGAPI@("ENCOUNTER",1,"SERVICE CATEGORY")="I"
+12 ; ---------------encounter type---------------
+13 SET @DGAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
+14 ; ------------primary provider----------------
+15 SET @DGAPI@("PROVIDER",1,"NAME")=$PIECE(DGZPRF(DGZP),"^",3)
+16 SET @DGAPI@("PROVIDER",1,"PRIMARY")=1
+17 ; ------------secondary provider-------------
+18 IF $PIECE(DGZPRF(DGZP),"^",2)
IF $PIECE(DGZPRF(DGZP),"^",2)'=$PIECE(DGZPRF(DGZP),"^",3)
SET @DGAPI@("PROVIDER",2,"NAME")=$PIECE(DGZPRF(DGZP),"^",2)
+19 ; ----------------procedures-----------------
+20 SET DGC=0
SET DGPROC=0
FOR
SET DGPROC=$ORDER(DGZPRF(DGZP,DGPROC))
if 'DGPROC
QUIT
Begin DoDot:1
+21 SET DGPROCZ=$GET(DGZPRF(DGZP,DGPROC))
if 'DGPROCZ
QUIT
+22 SET DGC=DGC+1
SET @DGAPI@("PROCEDURE",DGC,"PROCEDURE")=+DGPROCZ
+23 ; --------------modifiers------------------
+24 FOR DGP=2,3
IF $PIECE(DGPROCZ,"^",DGP)
SET @DGAPI@("PROCEDURE",DGC,"MODIFIERS",$PIECE($$MOD^ICPTMOD($PIECE(DGPROCZ,"^",DGP),"I",+DGZPRF(DGZP)),"^",2))=""
+25 ; --------------quantity-------------------
+26 SET @DGAPI@("PROCEDURE",DGC,"QTY")=$PIECE(DGPROCZ,"^",14)
+27 ; --------------diagnosis------------------
+28 FOR DGP=4:1:7,15:1:18
IF $PIECE(DGPROCZ,"^",DGP)
Begin DoDot:2
+29 SET DGDXNO=$SELECT(DGP=4:"",DGP<15:DGP-3,1:DGP-11)
+30 SET @DGAPI@("PROCEDURE",DGC,"DIAGNOSIS"_$SELECT(DGDXNO<2:"",1:" "_DGDXNO))=$PIECE(DGPROCZ,"^",DGP)
+31 IF $DATA(DGDX($PIECE(DGPROCZ,"^",DGP)))
QUIT
+32 SET DGDX($PIECE(DGPROCZ,"^",DGP))=""
SET DGDXC=DGDXC+1
+33 SET @DGAPI@("DX/PL",DGDXC,"DIAGNOSIS")=$PIECE(DGPROCZ,"^",DGP)
+34 if DGDXC=1
SET @DGAPI@("DX/PL",DGDXC,"PRIMARY")=1
+35 SET (DGY,DGX)=0
FOR
SET DGX=$ORDER(^DGICD9(46.1,"C",PTF,DGX))
if 'DGX!(DGY)
QUIT
IF +$GET(^DGICD9(46.1,DGX,0))=$PIECE(DGPROCZ,"^",DGP)
SET DGY=DGX
+36 SET DGY=$GET(^DGICD9(46.1,+DGY,0))
+37 IF $LENGTH($PIECE(DGY,"^",2))
SET @DGAPI@("DX/PL",DGDXC,"PL SC")=$PIECE(DGY,"^",2)
+38 IF $LENGTH($PIECE(DGY,"^",3))
SET @DGAPI@("DX/PL",DGDXC,"PL AO")=$PIECE(DGY,"^",3)
+39 IF $LENGTH($PIECE(DGY,"^",4))
SET @DGAPI@("DX/PL",DGDXC,"PL IR")=$PIECE(DGY,"^",4)
+40 IF $LENGTH($PIECE(DGY,"^",5))
SET @DGAPI@("DX/PL",DGDXC,"PL EC")=$PIECE(DGY,"^",5)
+41 IF $LENGTH($PIECE(DGY,"^",6))
SET @DGAPI@("DX/PL",DGDXC,"PL MST")=$PIECE(DGY,"^",6)
+42 IF $LENGTH($PIECE(DGY,"^",7))
SET @DGAPI@("DX/PL",DGDXC,"PL HNC")=$PIECE(DGY,"^",7)
+43 IF $LENGTH($PIECE(DGY,"^",8))
SET @DGAPI@("DX/PL",DGDXC,"PL CV")=$PIECE(DGY,"^",8)
+44 IF $LENGTH($PIECE(DGY,"^",9))
SET @DGAPI@("DX/PL",DGDXC,"PL SHAD")=$PIECE(DGY,"^",9)
End DoDot:2
End DoDot:1
+45 ;
+46 QUIT
+47 ;
