APCLAP12.m

APCLAP12 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ;

EOJ ;EP

 K APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLPPOV,APCLX,APCLHIGH,APCLDX,APCLLOW,APCLICD,APCLDA1,APCLDA2,APCLY,APCLSRT2,APCLDATE,APCLPROV,APCLSEC,APCLZ,APCLLOCC

 Q

DISC ;EP

 S APCLSRT2=APCLDISC

 I APCLDISC["?" S APCLDISC="DISCIPLINE NOT AVAILABLE" Q

 S APCLDISC=$P(^DIC(7,APCLY,0),U)

 Q

CLIN ;EP

 I APCLCLIN=9999 S APCLSRT2=9999,APCLCLIN="NO CLINIC ENTERED" Q

 S APCLSRT2=$P(^DIC(40.7,APCLCLIN,0),U,2),APCLCLIN=$P(^DIC(40.7,APCLCLIN,0),U)

 Q

DATE ;EP

 S APCLDATE=$P(APCLODAT,".")

 S X=APCLDATE D H^%DTC S APCLSRT2=$P("SUNDAY;MONDAY;TUESDAY;WEDNESDAY;THURSDAY;FRIDAY;SATURDAY",";",%Y+1) I APCLSRT2="" S APCLSRT2="UNKNOWN"

 Q

PROV ;EP

 S APCLPROV=$S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLAP,0),U),1:$P(^DIC(16,APCLAP,0),U))

 S APCLSRT2=$S($P(^DD(9000010.06,.01,0),U,2)[200:$$PROVCLS^XBFUNC1(APCLAP),APCLY:$P($G(^DIC(7,APCLY,0)),U),1:"")

 I APCLSRT2="" S APCLSRT2="PROVIDER CLASS UNAVAILABLE" Q

 Q

APCLAP12  ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;

EOJ       ;EP

 +1        KILL APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLPPOV,APCLX,APCLHIGH,APCLDX,APCLLOW,APCLICD,APCLDA1,APCLDA2,APCLY,APCLSRT2,APCLDATE,APCLPROV,APCLSEC,APCLZ,APCLLOCC

 +2        QUIT 

DISC      ;EP

 +1        SET APCLSRT2=APCLDISC

 +2        IF APCLDISC["?"

               SET APCLDISC="DISCIPLINE NOT AVAILABLE"

               QUIT 

 +3        SET APCLDISC=$PIECE(^DIC(7,APCLY,0),U)

 +4        QUIT 

CLIN      ;EP

 +1        IF APCLCLIN=9999

               SET APCLSRT2=9999

               SET APCLCLIN="NO CLINIC ENTERED"

               QUIT 

 +2        SET APCLSRT2=$PIECE(^DIC(40.7,APCLCLIN,0),U,2)

           SET APCLCLIN=$PIECE(^DIC(40.7,APCLCLIN,0),U)

 +3        QUIT 

DATE      ;EP

 +1        SET APCLDATE=$PIECE(APCLODAT,".")

 +2        SET X=APCLDATE

           DO H^%DTC

           SET APCLSRT2=$PIECE("SUNDAY;MONDAY;TUESDAY;WEDNESDAY;THURSDAY;FRIDAY;SATURDAY",";",%Y+1)

           IF APCLSRT2=""

               SET APCLSRT2="UNKNOWN"

 +3        QUIT 

PROV      ;EP

 +1        SET APCLPROV=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLAP,0),U),1:$PIECE(^DIC(16,APCLAP,0),U))

 +2        SET APCLSRT2=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$$PROVCLS^XBFUNC1(APCLAP),APCLY:$PIECE($GET(^DIC(7,APCLY,0)),U),1:"")

 +3        IF APCLSRT2=""

               SET APCLSRT2="PROVIDER CLASS UNAVAILABLE"

               QUIT 

 +4        QUIT