source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGAPI1.m@ 836

Last change on this file since 836 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1DGAPI1 ;ALB/DWS - DG API TO COMUNICATE WITH PCE ;6/16/05 1:44pm
2 ;;5.3;Registration;**635**;Aug 13, 1993
3DATA2PCE(DFN,PTF,DGZP) ;SEND CPT PROCEDURE TRANSACTIONS TO PCE
4 ;
5 N DGVISIT,DR,DIE,DA,X,Y
6 ;
7 D BUILD
8 ;
9 I $P($G(DGZPRF(DGZP)),U,6) S DGVISIT=$P(DGZPRF(DGZP),U,6)
10 ;
11 S RES=$$DATA2PCE^PXAPI("^TMP(""DGPCE1"",$J,""PXAPI"")",107,"801 SCREEN",.DGVISIT)
12 ;
13 D:$D(^TMP("DGPCE1",$J,"PXAPI","DIERR")) ERR
14 ;
15 K ^TMP("DGPCE1",$J,"PXAPI")
16 ;
17 ;
18 Q:RES<-1 RES
19 ;
20 S DR=".06////"_DGVISIT_";.07////1",DIE="^DGPT("_PTF_",""C"",",DA=DGZPRF(DGZP,0),DA(1)=PTF D ^DIE
21 ;
22 Q RES
23 ;
24ERR ; looks to see if there is an trully an error
25 N DGX,DGQ
26 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)
27 Q
28 ;
29ERRMSG(DGX) ; sends the error message
30 N XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG,DGL,DGTXT,DGY
31 ;
32 D DEM^VADPT
33 ;
34 S XMDUZ="PTF MODULE",XMSUB="801 to PCE filing error"
35 S XMY("G.DG PTF 801 TO PCE ERROR")="",XMY(DUZ)="",XMTEXT="DGTXT("
36 ;
37 S DGTXT(1,0)="An error has occured while sending PTF 801 data to PCE."
38 S DGTXT(2,0)=" "
39 S DGTXT(3,0)=" Patient Name: "_VADM(1)
40 S DGTXT(4,0)=" Social Security: "_$P(VADM(2),"^",2)
41 S DGTXT(5,0)=" Date/Time: "_$$FMTE^XLFDT(+DGZPRF(DGZP))
42 S DGTXT(6,0)=" Location: "_$P($G(^SC($P(DGZPRF(DGZP),"^",5),0)),"^")
43 S DGTXT(7,0)=" "
44 ;
45 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
46 . S DGL=DGL+1,DGTXT(DGL,0)=" "_^TMP("DGPCE1",$J,"PXAPI","DIERR",$J,DGX,"TEXT",DGY)
47 ;
48 D ^XMD
49 D KVAR^VADPT
50 ;
51 Q
52 ;
53DELVFILE(DFN,PTF,DGZP) ;DELETE VISIT IN PCE WHEN A CHANGE IS MADE
54 N DIE,DA,DR S RES=1
55 S:$P(DGZPRF(DGZP),U,7) RES=$$DELVFILE^PXAPI("ALL",$P(DGZPRF(DGZP),U,6))
56 S DA=DGZPRF(DGZP,0),DA(1)=PTF
57 S DIE="^DGPT("_PTF_",""C"",",DR=".06///@;.07////0" D ^DIE
58 Q RES
59 ;
60BUILD ; now build array for passing data to PCE
61 N DGAPI,DGC,DGPROC,DGPROCZ,DGP,DGDXNO,DGDXC,DGDX,DGX
62 K ^TMP("DGPCE1",$J,"PXAPI") S DGDXC=0
63 S DGAPI=$NA(^TMP("DGPCE1",$J,"PXAPI"))
64 ; ---------encounter date/time----------------
65 S @DGAPI@("ENCOUNTER",1,"ENC D/T")=+DGZPRF(DGZP)
66 ; --------------patient-----------------------
67 S @DGAPI@("ENCOUNTER",1,"PATIENT")=DFN
68 ; ---------------location---------------------
69 S @DGAPI@("ENCOUNTER",1,"HOS LOC")=$P(DGZPRF(DGZP),"^",5)
70 ; --------------service category--------------
71 S @DGAPI@("ENCOUNTER",1,"SERVICE CATEGORY")="I"
72 ; ---------------encounter type---------------
73 S @DGAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
74 ; ------------primary provider----------------
75 S @DGAPI@("PROVIDER",1,"NAME")=$P(DGZPRF(DGZP),"^",3)
76 S @DGAPI@("PROVIDER",1,"PRIMARY")=1
77 ; ------------secondary provider-------------
78 I $P(DGZPRF(DGZP),"^",2),$P(DGZPRF(DGZP),"^",2)'=$P(DGZPRF(DGZP),"^",3) S @DGAPI@("PROVIDER",2,"NAME")=$P(DGZPRF(DGZP),"^",2)
79 ; ----------------procedures-----------------
80 S DGC=0,DGPROC=0 F S DGPROC=$O(DGZPRF(DGZP,DGPROC)) Q:'DGPROC D
81 . S DGPROCZ=$G(DGZPRF(DGZP,DGPROC)) Q:'DGPROCZ
82 . S DGC=DGC+1,@DGAPI@("PROCEDURE",DGC,"PROCEDURE")=+DGPROCZ
83 . ; --------------modifiers------------------
84 . F DGP=2,3 I $P(DGPROCZ,"^",DGP) S @DGAPI@("PROCEDURE",DGC,"MODIFIERS",$P($$MOD^ICPTMOD($P(DGPROCZ,"^",DGP),"I",+DGZPRF(DGZP)),"^",2))=""
85 . ; --------------quantity-------------------
86 . S @DGAPI@("PROCEDURE",DGC,"QTY")=$P(DGPROCZ,"^",14)
87 . ; --------------diagnosis------------------
88 . F DGP=4:1:7,15:1:18 I $P(DGPROCZ,"^",DGP) D
89 . . S DGDXNO=$S(DGP=4:"",DGP<15:DGP-3,1:DGP-11)
90 . . S @DGAPI@("PROCEDURE",DGC,"DIAGNOSIS"_$S(DGDXNO<2:"",1:" "_DGDXNO))=$P(DGPROCZ,"^",DGP)
91 . . I $D(DGDX($P(DGPROCZ,"^",DGP))) Q
92 . . S DGDX($P(DGPROCZ,"^",DGP))="",DGDXC=DGDXC+1
93 . . S @DGAPI@("DX/PL",DGDXC,"DIAGNOSIS")=$P(DGPROCZ,"^",DGP)
94 . . S:DGDXC=1 @DGAPI@("DX/PL",DGDXC,"PRIMARY")=1
95 . . 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
96 . . S DGY=$G(^DGICD9(46.1,+DGY,0))
97 . . I $L($P(DGY,"^",2)) S @DGAPI@("DX/PL",DGDXC,"PL SC")=$P(DGY,"^",2)
98 . . I $L($P(DGY,"^",3)) S @DGAPI@("DX/PL",DGDXC,"PL AO")=$P(DGY,"^",3)
99 . . I $L($P(DGY,"^",4)) S @DGAPI@("DX/PL",DGDXC,"PL IR")=$P(DGY,"^",4)
100 . . I $L($P(DGY,"^",5)) S @DGAPI@("DX/PL",DGDXC,"PL EC")=$P(DGY,"^",5)
101 . . I $L($P(DGY,"^",6)) S @DGAPI@("DX/PL",DGDXC,"PL MST")=$P(DGY,"^",6)
102 . . I $L($P(DGY,"^",7)) S @DGAPI@("DX/PL",DGDXC,"PL HNC")=$P(DGY,"^",7)
103 . . I $L($P(DGY,"^",8)) S @DGAPI@("DX/PL",DGDXC,"PL CV")=$P(DGY,"^",8)
104 ;
105 Q
106 ;
Note: See TracBrowser for help on using the repository browser.