- GMTSPXSK ; SLC/SBW,KER - PCE Skin Test comp ; 08/27/2002
- ;;2.7;Health Summary;**8,10,28,56**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 1240 SKIN^PXRHS04
- ; DBIA 10011 ^DIWP
- ;
- SKIN ; Main Entry Point
- K ^TMP("PXS",$J) D SKIN^PXRHS04(DFN) Q:'$D(^TMP("PXS",$J))
- D CKP^GMTSUP Q:$D(GMTSQIT) D HDR
- N GMSK,GMDT,GMIFN,GMW,GMSITE,GMSKIN,GMN0,GMN1,GMRDG,X,GMTSDAT,GMRES
- N COMMENT,GMICL,GMRDT,GMTSLN,GMTAB S GMSK=""
- F S GMSK=$O(^TMP("PXS",$J,GMSK)) Q:GMSK="" D Q:$D(GMTSQIT)
- . S (GMDT,GMW)=0
- . F S GMDT=$O(^TMP("PXS",$J,GMSK,GMDT)) Q:GMDT'>0 D Q:$D(GMTSQIT)
- . . S GMIFN=0
- . . F S GMIFN=$O(^TMP("PXS",$J,GMSK,GMDT,GMIFN)) Q:GMIFN'>0 D SKINDSP Q:$D(GMTSQIT)
- K ^TMP("PXS",$J)
- Q
- HDR ; Display Header
- W ?38," - Date - ",!
- W "Skin Test",?15,"Reading",?24,"Results",?37,"Admin.",?45,"Reading",?60,"Facility",!!
- Q
- SKINDSP ; Display Skin Test Data
- S GMN0=$G(^TMP("PXS",$J,GMSK,GMDT,GMIFN,0)) Q:GMN0']""
- S GMN1=$G(^TMP("PXS",$J,GMSK,GMDT,GMIFN,1))
- S GMSITE=$S($P(GMN1,U,3)]"":$E($P(GMN1,U,3),1,10),$P(GMN1,U,4)]"":$E($P(GMN1,U,4),1,10),1:"No Site")
- S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDAT=X
- S GMSKIN=$P(GMN0,U),GMRDG=$P(GMN0,U,5)
- S X=$P(GMN0,U,6) D REGDT4^GMTSU S GMRDT=X
- I GMRDG]"" S GMRDG=$J(GMRDG,2)_" mm"
- S GMRES=$P(GMN0,U,4)
- I GMRDG']"",GMRES']"" S GMRES="UNREPORTED"
- D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR W:GMW'>0!GMTSNPG GMSKIN W ?15,GMRDG,?24,GMRES,?35,GMTSDAT,?47,GMRDT,?62,$E(GMSITE,1,17),!
- S COMMENT=$P($G(^TMP("PXS",$J,GMSK,GMDT,GMIFN,"COM")),U)
- I COMMENT]"" S GMICL=15,GMTAB=2 D FORMAT I $D(^UTILITY($J,"W")) D
- . F GMTSLN=1:1:^UTILITY($J,"W",DIWL) D LINE Q:$D(GMTSQIT)
- S GMW=1
- Q
- FORMAT ; Format Line
- N DIWR,DIWF,X S DIWL=3,DIWR=80-(GMICL+GMTAB) K ^UTILITY($J,"W")
- S X=COMMENT D ^DIWP
- Q
- LINE ; Write Line
- D CKP^GMTSUP Q:$D(GMTSQIT) W ?15,^UTILITY($J,"W",DIWL,GMTSLN,0),!
- Q
- GMTSPXSK ; SLC/SBW,KER - PCE Skin Test comp ; 08/27/2002
- +1 ;;2.7;Health Summary;**8,10,28,56**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 1240 SKIN^PXRHS04
- +5 ; DBIA 10011 ^DIWP
- +6 ;
- SKIN ; Main Entry Point
- +1 KILL ^TMP("PXS",$JOB)
- DO SKIN^PXRHS04(DFN)
- IF '$DATA(^TMP("PXS",$JOB))
- QUIT
- +2 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- DO HDR
- +3 NEW GMSK,GMDT,GMIFN,GMW,GMSITE,GMSKIN,GMN0,GMN1,GMRDG,X,GMTSDAT,GMRES
- +4 NEW COMMENT,GMICL,GMRDT,GMTSLN,GMTAB
- SET GMSK=""
- +5 FOR
- SET GMSK=$ORDER(^TMP("PXS",$JOB,GMSK))
- IF GMSK=""
- QUIT
- Begin DoDot:1
- +6 SET (GMDT,GMW)=0
- +7 FOR
- SET GMDT=$ORDER(^TMP("PXS",$JOB,GMSK,GMDT))
- IF GMDT'>0
- QUIT
- Begin DoDot:2
- +8 SET GMIFN=0
- +9 FOR
- SET GMIFN=$ORDER(^TMP("PXS",$JOB,GMSK,GMDT,GMIFN))
- IF GMIFN'>0
- QUIT
- DO SKINDSP
- IF $DATA(GMTSQIT)
- QUIT
- End DoDot:2
- IF $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- IF $DATA(GMTSQIT)
- QUIT
- +10 KILL ^TMP("PXS",$JOB)
- +11 QUIT
- HDR ; Display Header
- +1 WRITE ?38," - Date - ",!
- +2 WRITE "Skin Test",?15,"Reading",?24,"Results",?37,"Admin.",?45,"Reading",?60,"Facility",!!
- +3 QUIT
- SKINDSP ; Display Skin Test Data
- +1 SET GMN0=$GET(^TMP("PXS",$JOB,GMSK,GMDT,GMIFN,0))
- IF GMN0']""
- QUIT
- +2 SET GMN1=$GET(^TMP("PXS",$JOB,GMSK,GMDT,GMIFN,1))
- +3 SET GMSITE=$SELECT($PIECE(GMN1,U,3)]"":$EXTRACT($PIECE(GMN1,U,3),1,10),$PIECE(GMN1,U,4)]"":$EXTRACT($PIECE(GMN1,U,4),1,10),1:"No Site")
- +4 SET X=$PIECE(GMN0,U,2)
- DO REGDT4^GMTSU
- SET GMTSDAT=X
- +5 SET GMSKIN=$PIECE(GMN0,U)
- SET GMRDG=$PIECE(GMN0,U,5)
- +6 SET X=$PIECE(GMN0,U,6)
- DO REGDT4^GMTSU
- SET GMRDT=X
- +7 IF GMRDG]""
- SET GMRDG=$JUSTIFY(GMRDG,2)_" mm"
- +8 SET GMRES=$PIECE(GMN0,U,4)
- +9 IF GMRDG']""
- IF GMRES']""
- SET GMRES="UNREPORTED"
- +10 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- DO HDR
- IF GMW'>0!GMTSNPG
- WRITE GMSKIN
- WRITE ?15,GMRDG,?24,GMRES,?35,GMTSDAT,?47,GMRDT,?62,$EXTRACT(GMSITE,1,17),!
- +11 SET COMMENT=$PIECE($GET(^TMP("PXS",$JOB,GMSK,GMDT,GMIFN,"COM")),U)
- +12 IF COMMENT]""
- SET GMICL=15
- SET GMTAB=2
- DO FORMAT
- IF $DATA(^UTILITY($JOB,"W"))
- Begin DoDot:1
- +13 FOR GMTSLN=1:1:^UTILITY($JOB,"W",DIWL)
- DO LINE
- IF $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- +14 SET GMW=1
- +15 QUIT
- FORMAT ; Format Line
- +1 NEW DIWR,DIWF,X
- SET DIWL=3
- SET DIWR=80-(GMICL+GMTAB)
- KILL ^UTILITY($JOB,"W")
- +2 SET X=COMMENT
- DO ^DIWP
- +3 QUIT
- LINE ; Write Line
- +1 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE ?15,^UTILITY($JOB,"W",DIWL,GMTSLN,0),!
- +2 QUIT
