source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCEC800.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1PXCEC800 ;ISL/dee,ISA/KWP - Used in editing the 800 node, Service Connected conditions ;12/22/04 1:38pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**124,174**;Aug 12, 1996
3 ;; ;
4 Q
5 ;
6GET800 ;Used by the Service Connected Conditions
7 N PXCEINDX,PXOUT
8 N PXBDATA,PXLOC,PXAPTDT,PXDFN
9 I $O(^SCE("AVSIT",PXCEVIEN,0)) D CLASS^PXBAPI21("","","","",PXCEVIEN)
10 I '$O(^SCE("AVSIT",PXCEVIEN,0)) D
11 . S PXAPTDT=+^AUPNVSIT(PXCEVIEN,0)
12 . S PXDFN=$P(^AUPNVSIT(PXCEVIEN,0),"^",5)
13 . S PXLOC=$P(^AUPNVSIT(PXCEVIEN,0),"^",22)
14 . D CLASS^PXBAPI21("",PXDFN,PXAPTDT,PXLOC,"")
15 F PXCEINDX=1:1:7 I $G(PXBDATA("ERR",PXCEINDX))=4 S PXOUT=PXBDATA("ERR",PXCEINDX)
16 I $D(PXOUT) S PXCEEND=1 Q ;for visit and required fields
17 S $P(PXCEAFTR(800),"^",1)=$P($G(PXBDATA(3)),"^",2)
18 S $P(PXCEAFTR(800),"^",2)=$P($G(PXBDATA(1)),"^",2) S:$P(PXCEAFTR(800),"^",2)="" $P(PXCEAFTR(800),"^",2)="@"
19 S $P(PXCEAFTR(800),"^",3)=$P($G(PXBDATA(2)),"^",2) S:$P(PXCEAFTR(800),"^",3)="" $P(PXCEAFTR(800),"^",3)="@"
20 S $P(PXCEAFTR(800),"^",4)=$P($G(PXBDATA(4)),"^",2) S:$P(PXCEAFTR(800),"^",4)="" $P(PXCEAFTR(800),"^",4)="@"
21 S $P(PXCEAFTR(800),"^",5)=$P($G(PXBDATA(5)),"^",2)
22 S $P(PXCEAFTR(800),"^",6)=$P($G(PXBDATA(6)),"^",2)
23 S $P(PXCEAFTR(800),"^",7)=$P($G(PXBDATA(7)),"^",2)
24 Q
25 ;
Note: See TracBrowser for help on using the repository browser.