ACDVID.m

ACDVID ;IHS/ADC/EDE/KML - IDENTIFIERS FOR CDMIS VISIT FILE;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

START ;

 ; VALUE OF Y AND THE NAKED INDICATOR SET BY FILEMAN ROUTINE

 Q:'$G(Y)

 Q:'$D(^(0))

 S ACDVID=16 S:$X>16 ACDVID=24

 S ACDX=^(0)

 S ACDY=$P(ACDX,U,5)

 S ACDVID("PAT NAME")=$S(ACDY:$P($G(^DPT(ACDY,0)),U),1:"NO NAME")

 S ACDVID("PAT SEX")=$P(ACDX,U,12)

 S ACDY=$P(ACDX,U,2)

 S ACDVID("COMP CODE")=$S(ACDY:$P(^ACDCOMP(ACDY,0),U,2),1:"UNK")

 S ACDVID("COMP TYPE")=$P(ACDX,U,7)

 S ACDVID("TYPE CONTACT")=$P(ACDX,U,4)

 W ?ACDVID,$J(ACDVID("COMP CODE"),3)_"/"_ACDVID("COMP TYPE")_"  "_ACDVID("TYPE CONTACT")_"  "_ACDVID("PAT NAME")

 K ACDVID,ACDX,ACDY

 W @("$E("_DIC_"Y,0),0)") ; reset the naked

 Q

ACDVID    ;IHS/ADC/EDE/KML - IDENTIFIERS FOR CDMIS VISIT FILE;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

START     ;

 +1       ; VALUE OF Y AND THE NAKED INDICATOR SET BY FILEMAN ROUTINE

 +2        IF '$GET(Y)

               QUIT 

 +3        IF '$DATA(^(0))

               QUIT 

 +4        SET ACDVID=16

           IF $X>16

               SET ACDVID=24

 +5        SET ACDX=^(0)

 +6        SET ACDY=$PIECE(ACDX,U,5)

 +7        SET ACDVID("PAT NAME")=$SELECT(ACDY:$PIECE($GET(^DPT(ACDY,0)),U),1:"NO NAME")

 +8        SET ACDVID("PAT SEX")=$PIECE(ACDX,U,12)

 +9        SET ACDY=$PIECE(ACDX,U,2)

 +10       SET ACDVID("COMP CODE")=$SELECT(ACDY:$PIECE(^ACDCOMP(ACDY,0),U,2),1:"UNK")

 +11       SET ACDVID("COMP TYPE")=$PIECE(ACDX,U,7)

 +12       SET ACDVID("TYPE CONTACT")=$PIECE(ACDX,U,4)

 +13       WRITE ?ACDVID,$JUSTIFY(ACDVID("COMP CODE"),3)_"/"_ACDVID("COMP TYPE")_"  "_ACDVID("TYPE CONTACT")_"  "_ACDVID("PAT NAME")

 +14       KILL ACDVID,ACDX,ACDY

 +15      ; reset the naked

           WRITE @("$E("_DIC_"Y,0),0)")

 +16       QUIT