PXCEE800 ;ISL/dee,ISA/KWP - Used in editing the 800 node, Service Connected conditions ;06/06/05
;;1.0;PCE PATIENT CARE ENCOUNTER;**74,111,130,168**;Aug 12, 1996;Build 14
;; ;
Q
;
GET800 ;Used by all the Service Connected Conditions
;Do not ask if not primary visit.
Q:$P(PXCEAFTR(0),"^",22)'>0
Q:$P(PXCEAFTR(0),"^",8)'=$P(^SC($P(PXCEAFTR(0),"^",22),0),"^",7)
N PXCEINDX,PXOUT
N PXBDATA
D CLASS^PXBAPI21("",PXCEPAT,+PXCEAFTR(0),$P(PXCEAFTR(0),"^",22),PXCEFIEN)
;PX*1*111 - Add HNC
F PXCEINDX=1:1:8 I $G(PXBDATA("ERR",PXCEINDX))=4 S PXOUT=PXBDATA("ERR",PXCEINDX)
I $D(PXOUT) S (PXCEEND,PXCEQUIT)=1 Q ;for visit and required fields
S $P(PXCEAFTR(800),"^",1)=$P($G(PXBDATA(3)),"^",2)
S $P(PXCEAFTR(800),"^",2)=$P($G(PXBDATA(1)),"^",2)
S $P(PXCEAFTR(800),"^",3)=$P($G(PXBDATA(2)),"^",2)
S $P(PXCEAFTR(800),"^",4)=$P($G(PXBDATA(4)),"^",2)
S $P(PXCEAFTR(800),"^",5)=$P($G(PXBDATA(5)),"^",2)
;PX*1*111 - Add HNC
S $P(PXCEAFTR(800),"^",6)=$P($G(PXBDATA(6)),"^",2)
S $P(PXCEAFTR(800),"^",7)=$P($G(PXBDATA(7)),"^",2)
S $P(PXCEAFTR(800),"^",8)=$P($G(PXBDATA(8)),"^",2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEE800 1113 printed Nov 22, 2024@17:38 Page 2
PXCEE800 ;ISL/dee,ISA/KWP - Used in editing the 800 node, Service Connected conditions ;06/06/05
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**74,111,130,168**;Aug 12, 1996;Build 14
+2 ;; ;
+3 QUIT
+4 ;
GET800 ;Used by all the Service Connected Conditions
+1 ;Do not ask if not primary visit.
+2 if $PIECE(PXCEAFTR(0),"^",22)'>0
QUIT
+3 if $PIECE(PXCEAFTR(0),"^",8)'=$PIECE(^SC($PIECE(PXCEAFTR(0),"^",22),0),"^",7)
QUIT
+4 NEW PXCEINDX,PXOUT
+5 NEW PXBDATA
+6 DO CLASS^PXBAPI21("",PXCEPAT,+PXCEAFTR(0),$PIECE(PXCEAFTR(0),"^",22),PXCEFIEN)
+7 ;PX*1*111 - Add HNC
+8 FOR PXCEINDX=1:1:8
IF $GET(PXBDATA("ERR",PXCEINDX))=4
SET PXOUT=PXBDATA("ERR",PXCEINDX)
+9 ;for visit and required fields
IF $DATA(PXOUT)
SET (PXCEEND,PXCEQUIT)=1
QUIT
+10 SET $PIECE(PXCEAFTR(800),"^",1)=$PIECE($GET(PXBDATA(3)),"^",2)
+11 SET $PIECE(PXCEAFTR(800),"^",2)=$PIECE($GET(PXBDATA(1)),"^",2)
+12 SET $PIECE(PXCEAFTR(800),"^",3)=$PIECE($GET(PXBDATA(2)),"^",2)
+13 SET $PIECE(PXCEAFTR(800),"^",4)=$PIECE($GET(PXBDATA(4)),"^",2)
+14 SET $PIECE(PXCEAFTR(800),"^",5)=$PIECE($GET(PXBDATA(5)),"^",2)
+15 ;PX*1*111 - Add HNC
+16 SET $PIECE(PXCEAFTR(800),"^",6)=$PIECE($GET(PXBDATA(6)),"^",2)
+17 SET $PIECE(PXCEAFTR(800),"^",7)=$PIECE($GET(PXBDATA(7)),"^",2)
+18 SET $PIECE(PXCEAFTR(800),"^",8)=$PIECE($GET(PXBDATA(8)),"^",2)
+19 QUIT
+20 ;