ACKQRU ;AUG/JLTP BIR/PTD HCIOFO/AG-Support Routine for Reports ; [ 11/08/95 9:26 ]
 ;;3.0;QUASAR;;Feb 11, 2000
 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
DTRANGE ;
BEGDT N ACKTMPB
 S DIR(0)="D^:"_DT_":AEXP",DIR("A")="Beginning Date"
 S DIR("?")="Enter the earliest date for which you want to see data"
 S DIR("??")="^S ACKQHLP=1 D ^ACKQHLP"
 D ^DIR K DIR
 I Y?1"^"1.E W !,"Jumping not allowed.",! G BEGDT
 Q:$D(DIRUT)  S ACKBD=Y-.1,ACKXBD=$$NUMDT^ACKQUTL(Y),ACKTMPB=Y
 ;
ENDDT ; S DIR(0)="D^"_(ACKBD+.1)_":"_DT_":AEXP",DIR("A")="Ending Date"
 S DIR(0)="D"
 S DIR("A")="Ending Date"
 S DIR("?")="Enter the latest date for which you want to see data"
 S DIR("??")="^S ACKQHLP=1 D ^ACKQHLP"
 D ^DIR K DIR
 I Y?1"^"1.E W !,"Jumping not allowed.",! G ENDDT
 Q:$D(DIRUT)  S ACKED=Y+.9,ACKXED=$$NUMDT^ACKQUTL(Y)
 I Y<ACKTMPB W !,"End date cannot be before the Begin date.",! G ENDDT
 Q
PARAMS ;
 ; this subroutine contains two standard prompts
 ;  1.   Select     a = AUDIOLOGY
 ;                  s = SPEECH PATHOLOGY
 ;                  b = BOTH
 ;  2.   Choose     1 = ONE CLINICIAN
 ;                  2 = ONE OTHER PROVIDER
 ;                  3 = ONE STUDENT
 ;                  4 = ALL CLINICIANS
 ;                  5 = ALL OTHER PROVIDERS
 ;                  6 = ALL STUDENTS
 ; it returns
 ;     DIRUT=1    user chose to exit
 ;     ACKASB     response to prompt 1
 ;                (A=audio, S=speech, B=Both)
 ;     ACKSS      response to prompt 2 (1-6)
 ;     ACKSTF()   array containing all selected staff
 ;                where ACKSTF(n)=persons IEN on NEW PERSON FILE
 ;
 N DIR,I,X,Y,DIC,ACKQHLP
 ;
 ; prompt 1
 S DIR(0)="S^a:AUDIOLOGY;s:SPEECH PATHOLOGY;b:BOTH"
 S DIR("A")="Select",DIR("B")="BOTH"
 S DIR("??")="^W !!,""You can select Audiology visits, Speech Pathology visits, or Both."",!"
 D ^DIR K DIR Q:$D(DIRUT)
 S ACKASB=$S(Y="a":"A",Y="s":"S",1:"B")
 ;
 ; prompt 2
 S DIR(0)="S^1:ONE CLINICIAN;2:ONE OTHER PROVIDER;3:ONE STUDENT;4:ALL CLINICIANS;5:ALL OTHER PROVIDERS;6:ALL STUDENTS"
 S DIR("A")="Choose",DIR("??")="^S ACKQHLP=4 D ^ACKQHLP"
 D ^DIR K DIR Q:$D(DIRUT)
 S ACKSS=Y
 K ACKSTF
 ; if ONE staff member selected then ask for name
 I ACKSS<4 D  Q:$D(DIRUT)
 . S DIC("A")="Select "_$S(ACKSS=1:"CLINICIAN",ACKSS=2:"OTHER PROVIDER",1:"STUDENT")_": "
 . S DIC(0)="AEMQZ",DIC=509850.3
 . S DIC("S")="I $P(^(0),U,2)]"""",$P(""CF^O^S"",U,ACKSS)[$P(^(0),U,2)"
 . D ^DIC K DIC S:Y<0 DIRUT=1 Q:$D(DIRUT)
 . S ACKSTF(+Y)=$P(Y,U,2)
 ; if ALL staff selected then get them from staff file
 I ACKSS>3 D
 . S I=0 F  S I=$O(^ACK(509850.3,I)) Q:'I  D
 . . S X=$P(^ACK(509850.3,I,0),U,2)
 . . I X="" Q
 . . I ACKSS=4,"CF"'[X Q
 . . I ACKSS=5,X'="O" Q
 . . I ACKSS=6,X'="S" Q
 . . S ACKSTF(I)=$P(^ACK(509850.3,I,0),U)
 ;
 ; end
 Q
 ;
GETDIV(DIVARR,ACKSTA,ACKOPT) ; get all the Divisions and put them in DIVARR
 ;   INPUT: DIVARR must be passed by reference
 ;          ACKSTA division status (optional)
 ;                 'A' will get active divisions only (default)
 ;                 'I' will get inactive divisions only
 ;                 'AI' or 'IA' will get all divisions 
 ;          ACKOPT options. so far the only option is 'U' to output the
 ;                  names in uppercase.
 ;   RETURNS: DIVARR= number found (n)
 ;            DIVARR(1,n)=x^y^name
 ;            DIVARR(2,name)=n
 ;        and DIVARR(3,x)=n
 ;              where x=IEN of Div from Medical Center Division file
 ;                and y=sequence number from A&SP Site Parameter file
 ;                      (in other words ^ACK(509850.8,1,2,y)=x^...)
 ;                and name=the division name
 ;
 N ACKTGT,ACKMSG,ACKSCRN,ACK,SEQ,DIV,DIVNAME
 K DIVARR
 ; build screen based on requested status
 I $G(ACKSTA)="" S ACKSTA="A"
 S ACKSCRN="I """_ACKSTA_"""[$P(^(0),U,2)"
 ; go get 'em
 D LIST^DIC(509850.83,",1,",".01","I","*","","","",ACKSCRN,"","ACKTGT","ACKMSG")
 ; now transfer to output array
 S DIVARR=$P(ACKTGT("DILIST",0),U,1)
 FOR ACK=1:1:DIVARR D
 . S SEQ=ACKTGT("DILIST",2,ACK),DIV=ACKTGT("DILIST",1,ACK)
 . S DIVNAME=$$GET1^DIQ(40.8,DIV_",",.01)
 . S DIVARR(1,ACK)=DIV_U_SEQ_U_DIVNAME
 . S DIVARR(2,$$UP($G(ACKOPT),DIVNAME))=ACK
 . S DIVARR(3,DIV)=ACK
 Q
UP(ACKOPT,X) ; convert X to uppercase (if requested)
 I ACKOPT["U" Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 Q X
 ;
STOPSORT(ACKASB,ACKVSC) ; determine stop code sort value
 ; this function determines whether the Stop Code for the Visit is 
 ;  valid for the type of report selected. 
 ; If it is not valid the function returns 0
 ; If it is valid the function returns an integer which may be used to 
 ;  sequence the visit so that Audio comes first, Audio/Tel next,
 ;  then Speech and Speech/Tel.
 ; If an unknown Visit Stop Code is encountered, it is given a 9
 ;  which means it will appear at the end of the report as UNKNOWN.
 I ACKVSC="A" Q $S(ACKASB="A":1,ACKASB="B":1,1:0)  ; audiology #1
 I ACKVSC="AT" Q $S(ACKASB="A":2,ACKASB="B":2,1:0)  ; telephone audiology #2
 I ACKVSC="S" Q $S(ACKASB="S":3,ACKASB="B":3,1:0)  ; speech #3
 I ACKVSC="ST" Q $S(ACKASB="S":4,ACKASB="B":4,1:0)  ; telephone speech #4
 Q 9  ; any other value 9
 ;
STOPNM(ACKSORT) ; convert stop code sort value into a stop code name
 I ACKSORT=1 Q "AUDIOLOGY"
 I ACKSORT=2 Q "AUDIOLOGY TELEPHONE"
 I ACKSORT=3 Q "SPEECH PATHOLOGY"
 I ACKSORT=4 Q "SPEECH TELEPHONE"
 Q "UNKNOWN"
 ;