- 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
