PXVP233 ;ISP/LMT - PX*1*233 KIDS Routine ;Jan 19, 2023@10:48:38
;;1.0;PCE PATIENT CARE ENCOUNTER;**233**;Aug 12, 1996;Build 3
;
Q
;
POST ;
N PXSITES,PXSITE,PXIEN,PXERR,PXCNT
;
S PXSITES("RLFA")=""
S PXSITES("LLFA")=""
S PXSITES("RA")=""
S PXSITES("LA")=""
;
D BMES^XPDUTL("Setting values for parameter PXV SKIN TEST ADMIN SITES")
;
S PXCNT=0
S PXSITE=""
F S PXSITE=$O(PXSITES(PXSITE)) Q:PXSITE="" D
. S PXIEN=$O(^PXV(920.3,"B",PXSITE,0))
. I 'PXIEN Q
. S PXCNT=PXCNT+1
. K PXERR
. D EN^XPAR("PKG","PXV SKIN TEST ADMIN SITES",PXCNT,"`"_PXIEN,.PXERR)
. I +$G(PXERR)>0 D MES^XPDUTL(" ERROR #"_$P(PXERR,U)_": "_$P(PXERR,U,2))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVP233 679 printed Sep 23, 2025@20:07:55 Page 2
PXVP233 ;ISP/LMT - PX*1*233 KIDS Routine ;Jan 19, 2023@10:48:38
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**233**;Aug 12, 1996;Build 3
+2 ;
+3 QUIT
+4 ;
POST ;
+1 NEW PXSITES,PXSITE,PXIEN,PXERR,PXCNT
+2 ;
+3 SET PXSITES("RLFA")=""
+4 SET PXSITES("LLFA")=""
+5 SET PXSITES("RA")=""
+6 SET PXSITES("LA")=""
+7 ;
+8 DO BMES^XPDUTL("Setting values for parameter PXV SKIN TEST ADMIN SITES")
+9 ;
+10 SET PXCNT=0
+11 SET PXSITE=""
+12 FOR
SET PXSITE=$ORDER(PXSITES(PXSITE))
if PXSITE=""
QUIT
Begin DoDot:1
+13 SET PXIEN=$ORDER(^PXV(920.3,"B",PXSITE,0))
+14 IF 'PXIEN
QUIT
+15 SET PXCNT=PXCNT+1
+16 KILL PXERR
+17 DO EN^XPAR("PKG","PXV SKIN TEST ADMIN SITES",PXCNT,"`"_PXIEN,.PXERR)
+18 IF +$GET(PXERR)>0
DO MES^XPDUTL(" ERROR #"_$PIECE(PXERR,U)_": "_$PIECE(PXERR,U,2))
End DoDot:1
+19 QUIT
+20 ;
