APCDSKL.m

APCDSKL ; IHS/CMI/LAB - DISPLAY SKIN TESTS ;

 ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88

 ;

 ; MODIFIED FOR RPMS PCC DATA ENTRY 4-23-87/EDE

 ;

 D HEAD,HP,HD K APCDSKA D ^APCDSKL1

END K APCDSKLC,APCDSKLJ,APCDSKLL,APCDSKLS,APCDSKLV,APCDSKLY Q

HEAD W !?31,"Skin Test Record",!!

 Q

HP I $D(APCDPAT),$D(^DPT(APCDPAT,0)) S APCDSKLX=^(0),APCDSKLN=$P(APCDSKLX,"^"),APCDSKLS=$P(APCDSKLX,"^",2) W !,$P(APCDSKLN,","),", ",$P(APCDSKLN,",",2,99)

 S APCDSKLN=$P(APCDSKLX,"^",3) G H2:'APCDSKLN W ?24,"   ",$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",$E(APCDSKLN,4,5))," " W:$E(APCDSKLN,6,7) +$E(APCDSKLN,6,7)," " W $E(APCDSKLN,1,3)+1700

 ;S X1=DT,X2=APCDSKLN D ^%DTC S APCDSKLN=$S(X<60:X_" Days",X<913:$J(X/30.44,0,0)_" Months",1:$J(X/365.25,0,0)_" Years") W " (",APCDSKLN,")"

H2 W:APCDSKLS]"" ?55,"  ",$S(APCDSKLS="F":"FEMALE",APCDSKLS="M":"MALE",APCDSKLS="U":"UNKNOWN",1:"")  ;,"MALE"

 Q

HD W !!?7,"Date",?18,"Skin Test",?35,"Reading",?50,"Result",?61,"Date Read"

 W !?3,"------------",?18,"------------",?34,"------------",?49,"-----------",?61,"--------"

 Q

APCDSKL   ; IHS/CMI/LAB - DISPLAY SKIN TESTS ;

 +1       ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88

 +2       ;

 +3       ; MODIFIED FOR RPMS PCC DATA ENTRY 4-23-87/EDE

 +4       ;

 +5        DO HEAD

           DO HP

           DO HD

           KILL APCDSKA

           DO ^APCDSKL1

END        KILL APCDSKLC,APCDSKLJ,APCDSKLL,APCDSKLS,APCDSKLV,APCDSKLY

           QUIT 

HEAD       WRITE !?31,"Skin Test Record",!!

 +1        QUIT 

HP         IF $DATA(APCDPAT)

               IF $DATA(^DPT(APCDPAT,0))

                   SET APCDSKLX=^(0)

                   SET APCDSKLN=$PIECE(APCDSKLX,"^")

                   SET APCDSKLS=$PIECE(APCDSKLX,"^",2)

                   WRITE !,$PIECE(APCDSKLN,","),", ",$PIECE(APCDSKLN,",",2,99)

 +1        SET APCDSKLN=$PIECE(APCDSKLX,"^",3)

           IF 'APCDSKLN

               GOTO H2

           WRITE ?24,"   ",$PIECE("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",$EXTRACT(APCDSKLN,4,5))," "

           IF $EXTRACT(APCDSKLN,6,7)

               WRITE +$EXTRACT(APCDSKLN,6,7)," "

           WRITE $EXTRACT(APCDSKLN,1,3)+1700

 +2       ;S X1=DT,X2=APCDSKLN D ^%DTC S APCDSKLN=$S(X<60:X_" Days",X<913:$J(X/30.44,0,0)_" Months",1:$J(X/365.25,0,0)_" Years") W " (",APCDSKLN,")"

H2        ;,"MALE"

           IF APCDSKLS]""

               WRITE ?55,"  ",$SELECT(APCDSKLS="F":"FEMALE",APCDSKLS="M":"MALE",APCDSKLS="U":"UNKNOWN",1:"")

 +1        QUIT 

HD         WRITE !!?7,"Date",?18,"Skin Test",?35,"Reading",?50,"Result",?61,"Date Read"

 +1        WRITE !?3,"------------",?18,"------------",?34,"------------",?49,"-----------",?61,"--------"

 +2        QUIT