- AQAOUT ; IHS/ORDC/LJF - UTILITIES FOR QAI PKG ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This rtn contains various entry points for identifiers and output
- ;transforms on data fields.
- ;
- Q
- CRIT ;ENTRY POINT for output transform on name field in
- ; qi occ criteria file; code too long (>255 characters)
- N AQAOX,AQAOK
- S AQAOX=^AQAOCC(5,AQAOXX,0)
- I $P(AQAOX,U,5)'="" D G Q
- .W ?65," >>"_$S($P(AQAOX,U,5)=1:"YES",$P(AQAOX,U,5)=0:"NO",1:"N/A")
- .W "<<"
- I $P(AQAOX,U,6)'="",$D(^AQAO1(4,$P(AQAOX,U,6),0)) D G Q
- .W ?65," >>"_$P(^AQAO1(4,$P(AQAOX,U,6),0),U)_"<<"
- S AQAOK=$P(AQAOX,U,8)
- I AQAOK]"" D G Q
- .W ?65," >>",$E(AQAOK,4,5),"/",$E(AQAOK,6,7),"/",$E(AQAOK,2,3),"<<"
- I $P(AQAOX,U,7)'="" W ?65," >>",$P(AQAOX,U,7),"<<"
- ;
- Q ;quit
- Q
- ;
- ;
- DRUG ;ENTRY POINT for identifier on drug in data entry
- ;
- N Y,C
- S Y=$P(^AQAOCC(6,AQAOXX,0),U,5)
- S C=$P(^DD(9002166.6,.05,0),U,2)
- D Y^DIQ W:Y]"" " >>",Y,"<<"
- Q
- ;
- ;
- PROV ;ENTRY POINT to print identifiers on qi occ provider entries
- N X,Y
- S X=$$VALI^XBDIQ1(9002166.7,AQAOXX,.01) Q:X=""
- I X["AUTTVNDR" D Q ;vendor
- . S Z=$$VAL^XBDIQ1(9999999.11,+X,1103.01)
- . S Y=$$VALI^XBDIQ1(9999999.11,+X,1103)
- . I Z]"" W " CHS ",Z
- . E I Y]"" W " CHS ",$$VAL^XBDIQ1(9999999.34,Y,.02)
- . D LEVEL
- ;
- I $D(^XUSEC("PROVIDER",+X)) D Q ;provider
- . W " ",$$VAL^XBDIQ1(200,+X,9999999.01)," " ;affiliation
- . W $$VAL^XBDIQ1(200,+X,53.5) ;class
- . D LEVEL
- ;
- W " ",$$VAL^XBDIQ1(200,+X,8) ;title for person
- Q
- ;
- ;
- LEVEL ; -- SUBRTN to print prov/vendor/person type & level
- W " [",$$VALI^XBDIQ1(9002166.7,AQAOXX,.05) ;prov type
- W "/",$$VAL^XBDIQ1(9002166.7,AQAOXX,.07),"]" ;perf level
- I $$VALI^XBDIQ1(9002166.7,AQAOXX,.06) W "*" ;flagged with action
- Q
- AQAOUT ; IHS/ORDC/LJF - UTILITIES FOR QAI PKG ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This rtn contains various entry points for identifiers and output
- +4 ;transforms on data fields.
- +5 ;
- +6 QUIT
- CRIT ;ENTRY POINT for output transform on name field in
- +1 ; qi occ criteria file; code too long (>255 characters)
- +2 NEW AQAOX,AQAOK
- +3 SET AQAOX=^AQAOCC(5,AQAOXX,0)
- +4 IF $PIECE(AQAOX,U,5)'=""
- Begin DoDot:1
- +5 WRITE ?65," >>"_$SELECT($PIECE(AQAOX,U,5)=1:"YES",$PIECE(AQAOX,U,5)=0:"NO",1:"N/A")
- +6 WRITE "<<"
- End DoDot:1
- GOTO Q
- +7 IF $PIECE(AQAOX,U,6)'=""
- IF $DATA(^AQAO1(4,$PIECE(AQAOX,U,6),0))
- Begin DoDot:1
- +8 WRITE ?65," >>"_$PIECE(^AQAO1(4,$PIECE(AQAOX,U,6),0),U)_"<<"
- End DoDot:1
- GOTO Q
- +9 SET AQAOK=$PIECE(AQAOX,U,8)
- +10 IF AQAOK]""
- Begin DoDot:1
- +11 WRITE ?65," >>",$EXTRACT(AQAOK,4,5),"/",$EXTRACT(AQAOK,6,7),"/",$EXTRACT(AQAOK,2,3),"<<"
- End DoDot:1
- GOTO Q
- +12 IF $PIECE(AQAOX,U,7)'=""
- WRITE ?65," >>",$PIECE(AQAOX,U,7),"<<"
- +13 ;
- Q ;quit
- +1 QUIT
- +2 ;
- +3 ;
- DRUG ;ENTRY POINT for identifier on drug in data entry
- +1 ;
- +2 NEW Y,C
- +3 SET Y=$PIECE(^AQAOCC(6,AQAOXX,0),U,5)
- +4 SET C=$PIECE(^DD(9002166.6,.05,0),U,2)
- +5 DO Y^DIQ
- IF Y]""
- WRITE " >>",Y,"<<"
- +6 QUIT
- +7 ;
- +8 ;
- PROV ;ENTRY POINT to print identifiers on qi occ provider entries
- +1 NEW X,Y
- +2 SET X=$$VALI^XBDIQ1(9002166.7,AQAOXX,.01)
- IF X=""
- QUIT
- +3 ;vendor
- IF X["AUTTVNDR"
- Begin DoDot:1
- +4 SET Z=$$VAL^XBDIQ1(9999999.11,+X,1103.01)
- +5 SET Y=$$VALI^XBDIQ1(9999999.11,+X,1103)
- +6 IF Z]""
- WRITE " CHS ",Z
- +7 IF '$TEST
- IF Y]""
- WRITE " CHS ",$$VAL^XBDIQ1(9999999.34,Y,.02)
- +8 DO LEVEL
- End DoDot:1
- QUIT
- +9 ;
- +10 ;provider
- IF $DATA(^XUSEC("PROVIDER",+X))
- Begin DoDot:1
- +11 ;affiliation
- WRITE " ",$$VAL^XBDIQ1(200,+X,9999999.01)," "
- +12 ;class
- WRITE $$VAL^XBDIQ1(200,+X,53.5)
- +13 DO LEVEL
- End DoDot:1
- QUIT
- +14 ;
- +15 ;title for person
- WRITE " ",$$VAL^XBDIQ1(200,+X,8)
- +16 QUIT
- +17 ;
- +18 ;
- LEVEL ; -- SUBRTN to print prov/vendor/person type & level
- +1 ;prov type
- WRITE " [",$$VALI^XBDIQ1(9002166.7,AQAOXX,.05)
- +2 ;perf level
- WRITE "/",$$VAL^XBDIQ1(9002166.7,AQAOXX,.07),"]"
- +3 ;flagged with action
- IF $$VALI^XBDIQ1(9002166.7,AQAOXX,.06)
- WRITE "*"
- +4 QUIT
