Routine: PXCEC800

PXCEC800 ;ISL/DEE,ISA/KWP - Used in editing the 800 node, Service Connected conditions ;Aug 04, 2025@11:50:25

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**124,174,168,244**;Aug 12, 1996;Build 37

;;

 ; Reference to SCE("AVSIT" in ICR #2045

GET800 ;Used by the Service Connected Conditions

 N CNT,CODE,IDX,NODE,PXCEINDX,PXOUT,PXSAS,TEMP

 N PXBDATA,PXLOC,PXAPTDT,PXDFN

 I $O(^SCE("AVSIT",PXCEVIEN,0)) D CLASS^PXBAPI21("","","","",PXCEVIEN)

 I '$O(^SCE("AVSIT",PXCEVIEN,0)) D

 . S PXAPTDT=+^AUPNVSIT(PXCEVIEN,0)

 . S PXDFN=$P(^AUPNVSIT(PXCEVIEN,0),"^",5)

 . S PXLOC=$P(^AUPNVSIT(PXCEVIEN,0),"^",22)

 . D CLASS^PXBAPI21("",PXDFN,PXAPTDT,PXLOC,"")

 S IDX=0,CNT=0 F  S IDX=$O(PXBDATA(IDX)) Q:IDX'>0  D

 .S NODE=PXBDATA(IDX,0) S CODE=$$GETCODE^PXSPECAUTH(+$P(NODE,U)) S PXSAS(CODE)=$P(NODE,U,2)

 .S CNT=CNT+1,PXCEAFTR(900,CNT,0)=+$P(NODE,U)_U_$P(NODE,U,2)

 S PXCEAFTR(900)=$S(CNT>0:CNT,1:"")

 D SETOLD800^PXSPECAUTH(.TEMP,.PXSAS,$S('$O(^SCE("AVSIT",PXCEVIEN,0)):1,1:0))

 S PXCEAFTR(800)=TEMP

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEC800   1015     printed  Jul 11, 2026@02:24:12                                                                                                                                                                                                    Page 2

PXCEC800  ;ISL/DEE,ISA/KWP - Used in editing the 800 node, Service Connected conditions ;Aug 04, 2025@11:50:25

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**124,174,168,244**;Aug 12, 1996;Build 37

 +2       ;;

 +3       ; Reference to SCE("AVSIT" in ICR #2045

 +4       ;

 +5        QUIT

 +6       ;

GET800    ;Used by the Service Connected Conditions

 +1        NEW CNT,CODE,IDX,NODE,PXCEINDX,PXOUT,PXSAS,TEMP

 +2        NEW PXBDATA,PXLOC,PXAPTDT,PXDFN

 +3        IF $ORDER(^SCE("AVSIT",PXCEVIEN,0))

               DO CLASS^PXBAPI21("","","","",PXCEVIEN)

 +4        IF '$ORDER(^SCE("AVSIT",PXCEVIEN,0))

               Begin DoDot:1

 +5                SET PXAPTDT=+^AUPNVSIT(PXCEVIEN,0)

 +6                SET PXDFN=$PIECE(^AUPNVSIT(PXCEVIEN,0),"^",5)

 +7                SET PXLOC=$PIECE(^AUPNVSIT(PXCEVIEN,0),"^",22)

 +8                DO CLASS^PXBAPI21("",PXDFN,PXAPTDT,PXLOC,"")

               End DoDot:1

 +9        SET IDX=0

           SET CNT=0

FOR

               SET IDX=$ORDER(PXBDATA(IDX))

               if IDX'>0

                   QUIT

               Begin DoDot:1

 +10               SET NODE=PXBDATA(IDX,0)

                   SET CODE=$$GETCODE^PXSPECAUTH(+$PIECE(NODE,U))

                   SET PXSAS(CODE)=$PIECE(NODE,U,2)

 +11               SET CNT=CNT+1

                   SET PXCEAFTR(900,CNT,0)=+$PIECE(NODE,U)_U_$PIECE(NODE,U,2)

               End DoDot:1

 +12       SET PXCEAFTR(900)=$SELECT(CNT>0:CNT,1:"")

 +13       DO SETOLD800^PXSPECAUTH(.TEMP,.PXSAS,$SELECT('$ORDER(^SCE("AVSIT",PXCEVIEN,0)):1,1:0))

 +14       SET PXCEAFTR(800)=TEMP

 +15       QUIT

 +16      ;

PXCEC800.m