APCDSKL1 ; IHS/CMI/LAB - DISPLAY SKIN TESTS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
A0 S APCDSKLN="" F APCDSKLJ=1:1 S APCDSKLN=$O(^AUPNVSK("AC",APCDPAT,APCDSKLN)) Q:APCDSKLN="" I $D(^AUPNVSK(APCDSKLN,0)) S APCDSKLX=^(0) D SB1
XA0 S APCDSKLD="",APCDSKLC=0
A1 S APCDSKLD=$O(APCDSKLA(APCDSKLD)) G C1:APCDSKLD="" D DAT
A2 S APCDSKLN=""
A3 S APCDSKLN=$O(APCDSKLA(APCDSKLD,APCDSKLN)) I APCDSKLN="" K APCDSKLA(APCDSKLD) G A1
S APCDSKLI=$P(APCDSKLA(APCDSKLD,APCDSKLN),"^"),APCDSKLS=$P(APCDSKLA(APCDSKLD,APCDSKLN),"^",2),APCDSKLT=$P(APCDSKLA(APCDSKLD,APCDSKLN),"^",3),APCDSKLR=$P(APCDSKLA(APCDSKLD,APCDSKLN),"^",4)
A4 I APCDSKLI,$D(^AUTTSK(APCDSKLI,0)) S %I=$P(^(0),"^") S APCDSKLI=%I_" "_APCDSKLI
W !,$J(APCDSKLC,2)
W ?3,$J(APCDSKLW,12),?18,$J(APCDSKLI,12),?35,APCDSKLT,?52,APCDSKLS I APCDSKLR D DAR W ?61,APCDSKLW S APCDSKLW=""
G A3
C1 W:$Y<22 ! W !,"Press 'ENTER' To Continue: " D SBRS
C2 I '$D(DFOUT) D KIL Q
END ;
KIL K APCDSKLA,APCDSKLT,APCDSKLW,APCDSKLX,APCDSKLD,APCDSKLN,APCDSKLR,APCDSKLI,Y,APCDSKLM Q
SB1 S APCDSKLD=0,APCDSKLI=$P(APCDSKLX,"^"),APCDSKLV=$P(APCDSKLX,"^",3),APCDSKLS=$P(APCDSKLX,"^",4),APCDSKLL=$P(APCDSKLX,"^",5),APCDSKLR=$P(APCDSKLX,"^",6)
I APCDSKLV,$D(^AUPNVSIT(APCDSKLV,0)) S APCDSKLD=+$P(^(0),".")
S APCDSKLA(APCDSKLD,APCDSKLN)=APCDSKLI_"^"_APCDSKLS_"^"_APCDSKLL_"^"_APCDSKLR Q
DAR ;
S APCDSKLY=$E(APCDSKLR,1,3)+1700,APCDSKLM=$P(" ^Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",$E(APCDSKLR,4,5)+1),APCDSKLW=+$E(APCDSKLR,6,7) S:'APCDSKLW APCDSKLW=""
S:APCDSKLW APCDSKLW=$S(APCDSKLW<10:" ",1:"")_APCDSKLW S:APCDSKLM]"" APCDSKLW=APCDSKLM_$S(APCDSKLW]"":" ",1:"")_APCDSKLW_" " S APCDSKLW=APCDSKLW_APCDSKLY Q
REA ;
DAT I 'APCDSKLD S APCDSKLW="Not Listed" Q
S APCDSKLY=$E(APCDSKLD,1,3)+1700,APCDSKLM=$P(" ^Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",$E(APCDSKLD,4,5)+1),APCDSKLW=+$E(APCDSKLD,6,7) S:'APCDSKLW APCDSKLW=""
S:APCDSKLW APCDSKLW=$S(APCDSKLW<10:" ",1:"")_APCDSKLW S:APCDSKLM]"" APCDSKLW=APCDSKLM_$S(APCDSKLW]"":" ",1:"")_APCDSKLW_" " S APCDSKLW=APCDSKLW_APCDSKLY
Q
SBRS K DFOUT,DTOUT,DUOUT,DQOUT
R Y:$S($D(DTIME):DTIME,1:120) I '$T W $C(7) R Y:5 G SBRS:Y="." I '$T S (DTOUT,DFOUT)="" Q
I $D(USFO),USFO=Y W:$D(IOF) @IOF S (DFOUT,Y)="" Q
S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") (DQOUT,Y)=""
Q
APCDSKL1 ; IHS/CMI/LAB - DISPLAY SKIN TESTS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
A0 SET APCDSKLN=""
FOR APCDSKLJ=1:1
SET APCDSKLN=$ORDER(^AUPNVSK("AC",APCDPAT,APCDSKLN))
IF APCDSKLN=""
QUIT
IF $DATA(^AUPNVSK(APCDSKLN,0))
SET APCDSKLX=^(0)
DO SB1
XA0 SET APCDSKLD=""
SET APCDSKLC=0
A1 SET APCDSKLD=$ORDER(APCDSKLA(APCDSKLD))
IF APCDSKLD=""
GOTO C1
DO DAT
A2 SET APCDSKLN=""
A3 SET APCDSKLN=$ORDER(APCDSKLA(APCDSKLD,APCDSKLN))
IF APCDSKLN=""
KILL APCDSKLA(APCDSKLD)
GOTO A1
+1 SET APCDSKLI=$PIECE(APCDSKLA(APCDSKLD,APCDSKLN),"^")
SET APCDSKLS=$PIECE(APCDSKLA(APCDSKLD,APCDSKLN),"^",2)
SET APCDSKLT=$PIECE(APCDSKLA(APCDSKLD,APCDSKLN),"^",3)
SET APCDSKLR=$PIECE(APCDSKLA(APCDSKLD,APCDSKLN),"^",4)
A4 IF APCDSKLI
IF $DATA(^AUTTSK(APCDSKLI,0))
SET %I=$PIECE(^(0),"^")
SET APCDSKLI=%I_" "_APCDSKLI
+1 WRITE !,$JUSTIFY(APCDSKLC,2)
+2 WRITE ?3,$JUSTIFY(APCDSKLW,12),?18,$JUSTIFY(APCDSKLI,12),?35,APCDSKLT,?52,APCDSKLS
IF APCDSKLR
DO DAR
WRITE ?61,APCDSKLW
SET APCDSKLW=""
+3 GOTO A3
C1 IF $Y<22
WRITE !
WRITE !,"Press 'ENTER' To Continue: "
DO SBRS
C2 IF '$DATA(DFOUT)
DO KIL
QUIT
END ;
KIL KILL APCDSKLA,APCDSKLT,APCDSKLW,APCDSKLX,APCDSKLD,APCDSKLN,APCDSKLR,APCDSKLI,Y,APCDSKLM
QUIT
SB1 SET APCDSKLD=0
SET APCDSKLI=$PIECE(APCDSKLX,"^")
SET APCDSKLV=$PIECE(APCDSKLX,"^",3)
SET APCDSKLS=$PIECE(APCDSKLX,"^",4)
SET APCDSKLL=$PIECE(APCDSKLX,"^",5)
SET APCDSKLR=$PIECE(APCDSKLX,"^",6)
+1 IF APCDSKLV
IF $DATA(^AUPNVSIT(APCDSKLV,0))
SET APCDSKLD=+$PIECE(^(0),".")
+2 SET APCDSKLA(APCDSKLD,APCDSKLN)=APCDSKLI_"^"_APCDSKLS_"^"_APCDSKLL_"^"_APCDSKLR
QUIT
DAR ;
+1 SET APCDSKLY=$EXTRACT(APCDSKLR,1,3)+1700
SET APCDSKLM=$PIECE(" ^Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",$EXTRACT(APCDSKLR,4,5)+1)
SET APCDSKLW=+$EXTRACT(APCDSKLR,6,7)
IF 'APCDSKLW
SET APCDSKLW=""
+2 IF APCDSKLW
SET APCDSKLW=$SELECT(APCDSKLW<10:" ",1:"")_APCDSKLW
IF APCDSKLM]""
SET APCDSKLW=APCDSKLM_$SELECT(APCDSKLW]"":" ",1:"")_APCDSKLW_" "
SET APCDSKLW=APCDSKLW_APCDSKLY
QUIT
REA ;
DAT IF 'APCDSKLD
SET APCDSKLW="Not Listed"
QUIT
+1 SET APCDSKLY=$EXTRACT(APCDSKLD,1,3)+1700
SET APCDSKLM=$PIECE(" ^Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",$EXTRACT(APCDSKLD,4,5)+1)
SET APCDSKLW=+$EXTRACT(APCDSKLD,6,7)
IF 'APCDSKLW
SET APCDSKLW=""
+2 IF APCDSKLW
SET APCDSKLW=$SELECT(APCDSKLW<10:" ",1:"")_APCDSKLW
IF APCDSKLM]""
SET APCDSKLW=APCDSKLM_$SELECT(APCDSKLW]"":" ",1:"")_APCDSKLW_" "
SET APCDSKLW=APCDSKLW_APCDSKLY
+3 QUIT
SBRS KILL DFOUT,DTOUT,DUOUT,DQOUT
+1 READ Y:$SELECT($DATA(DTIME):DTIME,1:120)
IF '$TEST
WRITE $CHAR(7)
READ Y:5
IF Y="."
GOTO SBRS
IF '$TEST
SET (DTOUT,DFOUT)=""
QUIT
+2 IF $DATA(USFO)
IF USFO=Y
IF $DATA(IOF)
WRITE @IOF
SET (DFOUT,Y)=""
QUIT
+3 IF Y="^"
SET (DUOUT,Y)=""
IF Y?1"?".E!(Y["^")
SET (DQOUT,Y)=""
+4 QUIT
