- AQAOPV2 ; IHS/ORDC/LJF - PRINT PROVIDER QI CODES ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This rtn contians the user interface and call to DIP to print a
- ;listing of providers selected with their corresponding QI codes.
- ;
- SINGLE ;display of selected provider codes
- D SINGLE^AQAOHPRV ;intro text
- K AQAOARR ;make sure array is empty to start
- S AQAOX=0 ;flag for first time thru
- ASK ; >>> ask user for provider names to display
- K DIC S DIC=200,DIC(0)="AEQ",D="AK.PROVIDER",DIC("A")="Select "
- S DIC("A")=DIC("A")_$S('AQAOX:"PROVIDER NAME: ",1:"ANOTHER PROVIDER: ")
- S DIC("S")="I $P($G(^(""PS"")),U,4)=""""" ;screen out inactives
- D IX^DIC S AQAOX=1 G END:$D(DUOUT),END:$D(DTOUT),DEV:X="",DEV:Y=-1
- S AQAOARR(+Y)="" G ASK
- ;
- DEV ; >>> get print device
- G END:'$D(AQAOARR) ;no providers selected
- W !! S %ZIS="QP" D ^%ZIS G END:POP
- I '$D(IO("Q")) U IO G PRINT
- K IO("Q") S ZTRTN="PRINT^AQAOPV2",ZTDESC="SINGLE PROV CODES"
- S ZTSAVE("AQAOARR(")="" D ^%ZTLOAD K ZTSK D ^%ZISC
- ;
- D PRTOPT^AQAOVAR G END
- ;
- ;
- PRINT ; >>> loop thru selections and print data
- D INIT^AQAOUTIL S AQAOHCON="Provider",AQAOTY="PROVIDER QI CODES"
- D HEADING^AQAOUTIL,HEADING2 S AQAOX=0
- F S AQAOX=$O(AQAOARR(AQAOX)) Q:AQAOX="" Q:AQAOSTOP=U D
- .I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HEADING2
- .K ^UTILITY("DIQ1",$J)
- .S DIC=200,DR=".01;53.5;9999999.039",DA=AQAOX D EN^DIQ1
- .W !!,"PROVIDER NAME: ",$E($G(^UTILITY("DIQ1",$J,200,DA,.01)),1,25)
- .W ?45,"PROVIDER CLASS: ",$E($G(^UTILITY("DIQ1",$J,200,DA,53.3)),1,18)
- .W !?6,"QI CODE: ",AQAOX
- .W ?51,"PCC CODE: ",$G(^UTILITY("DIQ1",$J,200,DA,9999999.039))
- ;
- I '$D(ZTQUEUED),(IOST["C-") D PRTOPT^AQAOVAR ;ask to hit return
- END ; >>> eoj
- K ^UTILITY("DIQ1",$J) D ^%ZISC D KILL^AQAOUTIL Q
- ;
- ;
- HEADING2 ; >>> SUBRTN to print second half of heading
- W ?14,"(Please forward INACTIVE PROVIDER NAMES to proper dept.)"
- W !,AQAOLINE,! Q
- AQAOPV2 ; IHS/ORDC/LJF - PRINT PROVIDER QI CODES ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This rtn contians the user interface and call to DIP to print a
- +4 ;listing of providers selected with their corresponding QI codes.
- +5 ;
- SINGLE ;display of selected provider codes
- +1 ;intro text
- DO SINGLE^AQAOHPRV
- +2 ;make sure array is empty to start
- KILL AQAOARR
- +3 ;flag for first time thru
- SET AQAOX=0
- ASK ; >>> ask user for provider names to display
- +1 KILL DIC
- SET DIC=200
- SET DIC(0)="AEQ"
- SET D="AK.PROVIDER"
- SET DIC("A")="Select "
- +2 SET DIC("A")=DIC("A")_$SELECT('AQAOX:"PROVIDER NAME: ",1:"ANOTHER PROVIDER: ")
- +3 ;screen out inactives
- SET DIC("S")="I $P($G(^(""PS"")),U,4)="""""
- +4 DO IX^DIC
- SET AQAOX=1
- IF $DATA(DUOUT)
- GOTO END
- IF $DATA(DTOUT)
- GOTO END
- IF X=""
- GOTO DEV
- IF Y=-1
- GOTO DEV
- +5 SET AQAOARR(+Y)=""
- GOTO ASK
- +6 ;
- DEV ; >>> get print device
- +1 ;no providers selected
- IF '$DATA(AQAOARR)
- GOTO END
- +2 WRITE !!
- SET %ZIS="QP"
- DO ^%ZIS
- IF POP
- GOTO END
- +3 IF '$DATA(IO("Q"))
- USE IO
- GOTO PRINT
- +4 KILL IO("Q")
- SET ZTRTN="PRINT^AQAOPV2"
- SET ZTDESC="SINGLE PROV CODES"
- +5 SET ZTSAVE("AQAOARR(")=""
- DO ^%ZTLOAD
- KILL ZTSK
- DO ^%ZISC
- +6 ;
- +7 DO PRTOPT^AQAOVAR
- GOTO END
- +8 ;
- +9 ;
- PRINT ; >>> loop thru selections and print data
- +1 DO INIT^AQAOUTIL
- SET AQAOHCON="Provider"
- SET AQAOTY="PROVIDER QI CODES"
- +2 DO HEADING^AQAOUTIL
- DO HEADING2
- SET AQAOX=0
- +3 FOR
- SET AQAOX=$ORDER(AQAOARR(AQAOX))
- IF AQAOX=""
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:1
- +4 IF $Y>(IOSL-4)
- DO NEWPG^AQAOUTIL
- IF AQAOSTOP=U
- QUIT
- DO HEADING2
- +5 KILL ^UTILITY("DIQ1",$JOB)
- +6 SET DIC=200
- SET DR=".01;53.5;9999999.039"
- SET DA=AQAOX
- DO EN^DIQ1
- +7 WRITE !!,"PROVIDER NAME: ",$EXTRACT($GET(^UTILITY("DIQ1",$JOB,200,DA,.01)),1,25)
- +8 WRITE ?45,"PROVIDER CLASS: ",$EXTRACT($GET(^UTILITY("DIQ1",$JOB,200,DA,53.3)),1,18)
- +9 WRITE !?6,"QI CODE: ",AQAOX
- +10 WRITE ?51,"PCC CODE: ",$GET(^UTILITY("DIQ1",$JOB,200,DA,9999999.039))
- End DoDot:1
- +11 ;
- +12 ;ask to hit return
- IF '$DATA(ZTQUEUED)
- IF (IOST["C-")
- DO PRTOPT^AQAOVAR
- END ; >>> eoj
- +1 KILL ^UTILITY("DIQ1",$JOB)
- DO ^%ZISC
- DO KILL^AQAOUTIL
- QUIT
- +2 ;
- +3 ;
- HEADING2 ; >>> SUBRTN to print second half of heading
- +1 WRITE ?14,"(Please forward INACTIVE PROVIDER NAMES to proper dept.)"
- +2 WRITE !,AQAOLINE,!
- QUIT
