AQACSCCK.m

AQACSCCK ;IHS/ASU/RPL ;CHECK AND OFFER TO DELETE SCREENING CODE 0 IF 0 AND ANOTHER CODE PRESENT IN MULTIPLE FIELD ; 11/13/89  11:32 AM

 ;;QA/UR Version 2.04;11/7/89

 ;

 S AQAI=0 F AQAII=1:1 S AQAI=$O(@(DIE_AQAI_")")) Q:AQAI'=+AQAI  S AQA(AQAII)=@(DIE_AQAI_",0)") S:$P(^AQACSC(AQA(AQAII),0),U,1)=0 AQA0=AQAI

 G:'$D(AQA0)!(AQAII=2) QUIT W !!,"This Patient's Admission shows the following Codes:",! S AQAII=AQAII-1,DIWL=5,DIWR=79,DIWF="W" K ^UTILITY($J,"W")

 F AQAJ=1:1:AQAII W !,?4,"CODE "_$P(^AQACSC(AQA(AQAJ),0),U,1) D FRMT

 W *7,!,"Screening Code 0 is not usually appropriate in conjunction with any other Codes!",!,"Do you want to DELETE Screening Code 0 (Y/N)" S %=0 D YN^DICN G:%'=1 QUIT

 S DIK=DIE,DA=+AQA0 D ^DIK W !,"Screening Code 0 is DELETED!",!

QUIT K %,Y,AQAI,AQA,AQA0,AQAX,AQADA,AQAII,AQAJ

 Q

FRMT S X=$P(^AQACSC(AQA(AQAJ),0),U,2) D ^DIWP,^DIWW

 Q

AQACSCCK  ;IHS/ASU/RPL ;CHECK AND OFFER TO DELETE SCREENING CODE 0 IF 0 AND ANOTHER CODE PRESENT IN MULTIPLE FIELD ; 11/13/89  11:32 AM

 +1       ;;QA/UR Version 2.04;11/7/89

 +2       ;

 +3        SET AQAI=0

           FOR AQAII=1:1

               SET AQAI=$ORDER(@(DIE_AQAI_")"))

               IF AQAI'=+AQAI

                   QUIT 

               SET AQA(AQAII)=@(DIE_AQAI_",0)")

               IF $PIECE(^AQACSC(AQA(AQAII),0),U,1)=0

                   SET AQA0=AQAI

 +4        IF '$DATA(AQA0)!(AQAII=2)

               GOTO QUIT

           WRITE !!,"This Patient's Admission shows the following Codes:",!

           SET AQAII=AQAII-1

           SET DIWL=5

           SET DIWR=79

           SET DIWF="W"

           KILL ^UTILITY($JOB,"W")

 +5        FOR AQAJ=1:1:AQAII

               WRITE !,?4,"CODE "_$PIECE(^AQACSC(AQA(AQAJ),0),U,1)

               DO FRMT

 +6        WRITE *7,!,"Screening Code 0 is not usually appropriate in conjunction with any other Codes!",!,"Do you want to DELETE Screening Code 0 (Y/N)"

           SET %=0

           DO YN^DICN

           IF %'=1

               GOTO QUIT

 +7        SET DIK=DIE

           SET DA=+AQA0

           DO ^DIK

           WRITE !,"Screening Code 0 is DELETED!",!

QUIT       KILL %,Y,AQAI,AQA,AQA0,AQAX,AQADA,AQAII,AQAJ

 +1        QUIT 

FRMT       SET X=$PIECE(^AQACSC(AQA(AQAJ),0),U,2)

           DO ^DIWP

           DO ^DIWW

 +1        QUIT