Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: QACSRV

QACSRV.m

Go to the documentation of this file.
QACSRV ;WCIOFO/ERC - Report of Service/Discipline Iss Tot ;9/22/97
 ;;2.0;Patient Representative;**3,5,9,13**;07/25/1995
DATE ;
 N QACDIS,QACDSC,QACFLG S QACFLG=0
 N QACPIECE,QACSUB,QACTEXT
 N ZTSAVE
 D DATDIV^QACUTL0 G:QAQPOP EXIT^QACDISC
 S QACTEXT="Service/Discipline "
 S DIC="^QA(745.55,"
 D DIR^QACDISC(QACTEXT,DIC,.Y)
 I $G(QACQUIT)=1 D EXIT2^QACDISC Q
 S QACDSC=$P(Y,U,2)
 I $G(QACFLG)=1 S QACDSP=+Y
 K %ZIS,IOP S %ZIS="MQ" W ! D ^%ZIS G:POP EXIT^QACDISC
 I $D(IO("Q")) D  G EXIT^QACDISC
 . S (ZTSAVE("QACFLG"),ZTSAVE("QACTEXT"))=""
 . S (ZTSAVE("QACDSC"),ZTSAVE("QACDSP"),ZTSAVE("QACDIS"))=""
 . S (ZTSAVE("QACDIV"),ZTSAVE("QAC1DIV"),ZTSAVE("QACDV"))=""
 . S (ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"))=""
 . S (ZTSAVE("QACSRPT0"),ZTSAVE("QACSRPT1"),ZTSAVE("QACSRPT2"))=""
 . S ZTDESC="Patient Rep Service Report"
 . S ZTRTN="TSK^QACSRV"
 . D TASK^QACUTL0
 . Q
TSK ;
 S QACPIECE=1
 S QACSUB=2
 D TSK1^QACDISC(QACPIECE,QACSUB)
 Q