- 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 Feb 18, 2025@23:58:11 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 ;
