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
