- ACKQUTL2 ;AUG/JLTP BIR/PTD HCIOFO/AG -QUASAR Utility Routine ; [ 04/25/96 10:03 ]
- ;;3.0;QUASAR;**15**;Feb 11, 2000;Build 2
- ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
- ;
- ;
- DIVLIST(ACKTYP,ACKTXT) ; list on screen all the Divisions on the Site Parameter File
- ; optional ACKTYP = type of list 1=Active only, 0 (default) = all
- ; optional ACKTXT = preceding message
- N ACKFROM,ACKFDA,ACKMSG,ACKSCRN,DIWL,DIWR,DIWF,X,Y,I,DA,ACKCT
- S ACKFROM="",ACKTYP=$S(+$G(ACKTYP)=1:1,1:0)
- ; set up the screen if only active divisions are to be listed
- S ACKSCRN=$S(ACKTYP=1:"I $P(^(0),U,2)=""A""",1:"")
- ; call fileman to retrieve the Divisions
- D LIST^DIC(509850.83,",1,",".01;.02","","",.ACKFROM,"","",ACKSCRN,"","ACKFDA","ACKMSG")
- ; get count of number of Divisions
- S ACKCT=$P(ACKFDA("DILIST",0),U,1)
- ; determine the text header
- I ACKCT=0,ACKTYP=0 S ACKTXT=" No Divisions have been set up."
- I ACKCT=0,ACKTYP=1 S ACKTXT=" There are no Active Divisions on file."
- I $G(ACKTXT)="" D
- . I ACKCT>0 S ACKTXT=" The following Divisions have been set up..."
- ;
- ; the following section uses DIWP & DIWW to format and output the text
- S DIWL=5,DIWR=75,DIWF=""
- S X="|SETTAB(10,40)| " D ^DIWP
- S X=" " D ^DIWP ;blank line!
- S X=ACKTXT D ^DIWP
- ; now output each Division
- F ACK=1:1:ACKCT D
- . ; print division name
- . S X=" |TAB|"_$E(ACKFDA("DILIST",1,ACK),1,25)
- . ; if all divisions to be printed then also print the status
- . I ACKTYP=0 S X=X_"|TAB|"_$$MC(ACKFDA("DILIST","ID",ACK,.02))
- . D ^DIWP
- ; now write to the screen
- D ^DIWW
- ;
- ; end
- Q
- ;
- MC(X) ; convert X to mixed case (1st upper, remainder lower)
- N UP,LW S UP="ABCDEFGHIJKLMNOPQRSTUVWXYZ",LW="abcdefghijklmnopqrstuvwxyz"
- Q $TR($E(X),LW,UP)_$TR($E(X,2,999),UP,LW)
- ;
- ;
- DIV(ACKTYP,ACKDIV,ACKSTA) ; prompt user for an A&SP Division
- ; where ACKTYP can be 1=one div, 2=many, 3=many/all
- ; if ACTYPE>1 then ACKDIV must be passed in by reference
- ; and ACKSTA contains the required status of the Division
- ; so if ACKSTA="A" then only active divisions may be chosen
- ; if ACKSTA="I" then only inactive divisions may be chosen
- ; if ACKSTA="AI" or "IA" then either active or inactive may be
- ; chosen. If not passed then "A" is used as the default.
- ; ------------------------------------------------------------
- ; function returns:-
- ; ACKDIV=a^b where a=no. divisions selected, and b=total
- ; available divisions.
- ; (if the user quits or times out then a=0)
- ; ACKDIV(x)=x^y^z where
- ; x=div ien on Med Cen Div file #40.8,
- ; y=div ien on Site Parameters #509850.83
- ; and z=division name
- ; ------------------------------------------------------------
- N DIVARR,ACKDIVN,ACKN,ACKDEF,ACKDFLT,ACKIEN,ACKX
- K ACKDIV
- ; initialise selected Division
- S ACKDIV=""
- ;
- ; check parameter has been passed in
- I "1/2/3"'[+$G(ACKTYP) G DIVX
- ;
- ; get list of divisions
- D GETDIV^ACKQRU(.DIVARR,$G(ACKSTA),"U")
- ;
- ; no Divisions exist
- I DIVARR<1 S ACKDIV=0 G DIVX
- ;
- ; only one Division exists
- I DIVARR=1 D G DIVX
- . S ACKDIV="1^1",ACKDIV($P(DIVARR(1,1),U,1))=$P(DIVARR(1,1),U,1,3)_U
- ;
- ; get last Division selected by the user (spacebar recall)
- S ACKDEF=$$FIND1^DIC(509850.83,",1,",""," ")
- S ACKDEF=$S(ACKDEF:$$EXTERNAL^DILFD(509850.83,".01","",ACKDEF),1:"")
- S ACKDEF=$$UC(ACKDEF) ; convert to uppercase
- I ACKDEF'="",'$D(DIVARR(2,ACKDEF)) S ACKDEF=""
- S ACKDFLT=$S(ACKDEF="":"",1:"2^"_ACKDEF)
- ;
- ; multiple divisions exist, only one required.
- I ACKTYP=1,DIVARR>1 D G DIVX
- . D SELECT^ACKQSEL(1,"DIVARR(2)","DIVARR(4)","DIVISION^35","D DIVHLP^ACKQUTL2",ACKDFLT)
- . ; get Division IEN
- . I $O(DIVARR(4,""))="" S ACKDIV="0^"_DIVARR Q ; either quit or timed out
- . S ACKDIVN=$O(DIVARR(4,"")),ACKN=DIVARR(2,ACKDIVN)
- . S ACKIEN=$P(DIVARR(1,ACKN),U,1)
- . D RECALL^DILFD(509850.83,ACKIEN_",1,",DUZ) ; save for spacebar recall
- . S ACKDIV="1^"_DIVARR
- . S ACKDIV(ACKIEN)=$P(DIVARR(1,ACKN),U,1,3)_U
- ;
- ; multiple divisions exist, user may select one/many or ALL.
- I ACKTYP>1,DIVARR>1 D G DIVX
- . D SELECT^ACKQSEL(ACKTYP,"DIVARR(2)","DIVARR(4)","DIVISION^35","D DIVHLP^ACKQUTL2",ACKDFLT)
- . ; get Division IEN
- . I $G(DIVARR(4))'="" S ACKDIV="0^"_DIVARR Q ;either quit or timed out
- . S ACKDIV=U_DIVARR
- . S ACKX="" F S ACKX=$O(DIVARR(4,ACKX)) Q:ACKX="" D
- . . S $P(ACKDIV,U,1)=$P(ACKDIV,U,1)+1,ACKN=DIVARR(2,ACKX)
- . . S ACKDIV($P(DIVARR(1,ACKN),U,1))=$P(DIVARR(1,ACKN),U,1,3)_U
- . ; if only one selected then save for spacebar recall
- . I +$P(ACKDIV,U,1)=1 D
- . . S ACKIEN=$O(ACKDIV("")) Q:'ACKIEN
- . . D RECALL^DILFD(509850.83,ACKIEN_",1,",DUZ) ; save for spacebar recall
- ;
- DIVX ; end
- Q ACKDIV
- ;
- ;
- DIVHLP ; displays help text for the Division prompt
- N X,DIWL,DIWR,DIWF
- S DIWL=1,DIWR=80,DIWF=""
- S X=" " D ^DIWP
- S X=" Enter the name of a Division from the A&SP Site Parameters File." D ^DIWP
- S X=" Enter '??' to see a list of the available Divisions, '^' to exit." D ^DIWP
- D ^DIWW
- Q
- LEADROLE(ACKVIEN) ; determine lead role for a visit
- ; prior to version 3.0 all visits would be filed with a Lead Role
- ; entered by the user (either the primary clinician, secondary
- ; clinician or other prov). With ver 3.0 this field is no longer
- ; populated and the lead role is the primary provider, or if absent
- ; the secondary provider. In order to be backward compatible this
- ; function will check the lead role field first. If it contains a
- ; value then the visit must be pre-ver 3.0 and this code must be
- ; the lead role selected by the user. If the lead role field is
- ; empty then the visit must be post-ver 3.0 and so this function
- ; will return either the primary or secondary provider.
- N ACKSECV2,ACKTGT,ACKMSG,ACKLEAD,ACKIENS,ACKPRIM,ACKSCND,ACKSTUD,ACKMSG1,ACKTGT1
- N ACK2
- S ACKIENS=ACKVIEN_","
- D GETS^DIQ(509850.6,ACKIENS,".25;.27;6","I","ACKTGT","ACKMSG")
- S ACKLEAD=ACKTGT(509850.6,ACKIENS,.27,"I") ; Lead role (Pre V.3.)
- I +ACKLEAD>0 Q +ACKLEAD
- S ACKPRIM=ACKTGT(509850.6,ACKIENS,6,"I") ; Primary clinician
- I +ACKPRIM>0 Q +ACKPRIM
- S ACKSECV2=ACKTGT(509850.6,ACKIENS,.25,"I") ; Pre V.3 Sec'dry clinician
- I +ACKSECV2>0 Q +ACKSECV2
- ;
- D LIST^DIC(509850.66,","_ACKVIEN_",",".01","I","*","","","","","","ACKTGT1","ACKMSG1")
- S ACKSCND=$O(ACKTGT1("DILIST",1,""))
- I ACKSCND'="" S ACKSCND=ACKTGT1("DILIST",1,ACKSCND)
- Q +ACKSCND ; First Secondary Provider V.3.
- ;
- ASPDIV(ACKDIV) ; returns true if ACKDIV is a valid ASP division
- N ACKTGT,ACKMSG,ACKFND
- ; look for the Division on the Site Parameters file
- D FIND^DIC(509850.83,",1,","","","`"_ACKDIV,1,"","","","ACKTGT","ACKMSG")
- ; get number found
- S ACKFND=$P($G(ACKTGT("DILIST",0)),U,1)
- Q (ACKFND=1)
- CLNDIV(ACKCLN) ; returns the ien of the division that the clinic is in.
- Q $$GET1^DIQ(44,ACKCLN_",",3.5,"I")
- ASPCLN(ACKCLN) ; returns true if ACKCLN is a valid clinic for ASP
- ; ACKCLN is the internal entry number from the hospital locations file
- ; true returned if stop code is 203-Audiology, 204-Speech
- ; if stop code is invalid then the credit stop code field must be either 203 or 204.
- N ACKSTOP,ACKCRDT,ACKSC
- ; get ien of stop code
- S ACKSTOP=$$GET1^DIQ(44,ACKCLN_",",8,"I")
- I ACKSTOP="" Q 0 ; bad clinic record
- ; get actual stop code
- S ACKSC=$$GET1^DIQ(40.7,ACKSTOP_",",1)
- ; exit
- I ACKSC=203 Q 1 ; audiology
- I ACKSC=204 Q 1 ; speech pathology
- ; get clinic credit stop code
- S ACKCRDT=$$GET1^DIQ(44,ACKCLN_",",2503,"I")
- I ACKCRDT="" Q 0 ; no credit stop code
- ; get actual stop code
- S ACKSC=$$GET1^DIQ(40.7,ACKCRDT_",",1)
- ; exit
- I ACKSC=203 Q 1 ; audiology
- I ACKSC=204 Q 1 ; speech pathology
- Q 0 ; any other value is invalid
- UC(X) ; convert X to uppercase
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQUTL2 7904 printed Jan 18, 2025@03:34 Page 2
- ACKQUTL2 ;AUG/JLTP BIR/PTD HCIOFO/AG -QUASAR Utility Routine ; [ 04/25/96 10:03 ]
- +1 ;;3.0;QUASAR;**15**;Feb 11, 2000;Build 2
- +2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
- +3 ;
- +4 ;
- DIVLIST(ACKTYP,ACKTXT) ; list on screen all the Divisions on the Site Parameter File
- +1 ; optional ACKTYP = type of list 1=Active only, 0 (default) = all
- +2 ; optional ACKTXT = preceding message
- +3 NEW ACKFROM,ACKFDA,ACKMSG,ACKSCRN,DIWL,DIWR,DIWF,X,Y,I,DA,ACKCT
- +4 SET ACKFROM=""
- SET ACKTYP=$SELECT(+$GET(ACKTYP)=1:1,1:0)
- +5 ; set up the screen if only active divisions are to be listed
- +6 SET ACKSCRN=$SELECT(ACKTYP=1:"I $P(^(0),U,2)=""A""",1:"")
- +7 ; call fileman to retrieve the Divisions
- +8 DO LIST^DIC(509850.83,",1,",".01;.02","","",.ACKFROM,"","",ACKSCRN,"","ACKFDA","ACKMSG")
- +9 ; get count of number of Divisions
- +10 SET ACKCT=$PIECE(ACKFDA("DILIST",0),U,1)
- +11 ; determine the text header
- +12 IF ACKCT=0
- IF ACKTYP=0
- SET ACKTXT=" No Divisions have been set up."
- +13 IF ACKCT=0
- IF ACKTYP=1
- SET ACKTXT=" There are no Active Divisions on file."
- +14 IF $GET(ACKTXT)=""
- Begin DoDot:1
- +15 IF ACKCT>0
- SET ACKTXT=" The following Divisions have been set up..."
- End DoDot:1
- +16 ;
- +17 ; the following section uses DIWP & DIWW to format and output the text
- +18 SET DIWL=5
- SET DIWR=75
- SET DIWF=""
- +19 SET X="|SETTAB(10,40)| "
- DO ^DIWP
- +20 ;blank line!
- SET X=" "
- DO ^DIWP
- +21 SET X=ACKTXT
- DO ^DIWP
- +22 ; now output each Division
- +23 FOR ACK=1:1:ACKCT
- Begin DoDot:1
- +24 ; print division name
- +25 SET X=" |TAB|"_$EXTRACT(ACKFDA("DILIST",1,ACK),1,25)
- +26 ; if all divisions to be printed then also print the status
- +27 IF ACKTYP=0
- SET X=X_"|TAB|"_$$MC(ACKFDA("DILIST","ID",ACK,.02))
- +28 DO ^DIWP
- End DoDot:1
- +29 ; now write to the screen
- +30 DO ^DIWW
- +31 ;
- +32 ; end
- +33 QUIT
- +34 ;
- MC(X) ; convert X to mixed case (1st upper, remainder lower)
- +1 NEW UP,LW
- SET UP="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- SET LW="abcdefghijklmnopqrstuvwxyz"
- +2 QUIT $TRANSLATE($EXTRACT(X),LW,UP)_$TRANSLATE($EXTRACT(X,2,999),UP,LW)
- +3 ;
- +4 ;
- DIV(ACKTYP,ACKDIV,ACKSTA) ; prompt user for an A&SP Division
- +1 ; where ACKTYP can be 1=one div, 2=many, 3=many/all
- +2 ; if ACTYPE>1 then ACKDIV must be passed in by reference
- +3 ; and ACKSTA contains the required status of the Division
- +4 ; so if ACKSTA="A" then only active divisions may be chosen
- +5 ; if ACKSTA="I" then only inactive divisions may be chosen
- +6 ; if ACKSTA="AI" or "IA" then either active or inactive may be
- +7 ; chosen. If not passed then "A" is used as the default.
- +8 ; ------------------------------------------------------------
- +9 ; function returns:-
- +10 ; ACKDIV=a^b where a=no. divisions selected, and b=total
- +11 ; available divisions.
- +12 ; (if the user quits or times out then a=0)
- +13 ; ACKDIV(x)=x^y^z where
- +14 ; x=div ien on Med Cen Div file #40.8,
- +15 ; y=div ien on Site Parameters #509850.83
- +16 ; and z=division name
- +17 ; ------------------------------------------------------------
- +18 NEW DIVARR,ACKDIVN,ACKN,ACKDEF,ACKDFLT,ACKIEN,ACKX
- +19 KILL ACKDIV
- +20 ; initialise selected Division
- +21 SET ACKDIV=""
- +22 ;
- +23 ; check parameter has been passed in
- +24 IF "1/2/3"'[+$GET(ACKTYP)
- GOTO DIVX
- +25 ;
- +26 ; get list of divisions
- +27 DO GETDIV^ACKQRU(.DIVARR,$GET(ACKSTA),"U")
- +28 ;
- +29 ; no Divisions exist
- +30 IF DIVARR<1
- SET ACKDIV=0
- GOTO DIVX
- +31 ;
- +32 ; only one Division exists
- +33 IF DIVARR=1
- Begin DoDot:1
- +34 SET ACKDIV="1^1"
- SET ACKDIV($PIECE(DIVARR(1,1),U,1))=$PIECE(DIVARR(1,1),U,1,3)_U
- End DoDot:1
- GOTO DIVX
- +35 ;
- +36 ; get last Division selected by the user (spacebar recall)
- +37 SET ACKDEF=$$FIND1^DIC(509850.83,",1,",""," ")
- +38 SET ACKDEF=$SELECT(ACKDEF:$$EXTERNAL^DILFD(509850.83,".01","",ACKDEF),1:"")
- +39 ; convert to uppercase
- SET ACKDEF=$$UC(ACKDEF)
- +40 IF ACKDEF'=""
- IF '$DATA(DIVARR(2,ACKDEF))
- SET ACKDEF=""
- +41 SET ACKDFLT=$SELECT(ACKDEF="":"",1:"2^"_ACKDEF)
- +42 ;
- +43 ; multiple divisions exist, only one required.
- +44 IF ACKTYP=1
- IF DIVARR>1
- Begin DoDot:1
- +45 DO SELECT^ACKQSEL(1,"DIVARR(2)","DIVARR(4)","DIVISION^35","D DIVHLP^ACKQUTL2",ACKDFLT)
- +46 ; get Division IEN
- +47 ; either quit or timed out
- IF $ORDER(DIVARR(4,""))=""
- SET ACKDIV="0^"_DIVARR
- QUIT
- +48 SET ACKDIVN=$ORDER(DIVARR(4,""))
- SET ACKN=DIVARR(2,ACKDIVN)
- +49 SET ACKIEN=$PIECE(DIVARR(1,ACKN),U,1)
- +50 ; save for spacebar recall
- DO RECALL^DILFD(509850.83,ACKIEN_",1,",DUZ)
- +51 SET ACKDIV="1^"_DIVARR
- +52 SET ACKDIV(ACKIEN)=$PIECE(DIVARR(1,ACKN),U,1,3)_U
- End DoDot:1
- GOTO DIVX
- +53 ;
- +54 ; multiple divisions exist, user may select one/many or ALL.
- +55 IF ACKTYP>1
- IF DIVARR>1
- Begin DoDot:1
- +56 DO SELECT^ACKQSEL(ACKTYP,"DIVARR(2)","DIVARR(4)","DIVISION^35","D DIVHLP^ACKQUTL2",ACKDFLT)
- +57 ; get Division IEN
- +58 ;either quit or timed out
- IF $GET(DIVARR(4))'=""
- SET ACKDIV="0^"_DIVARR
- QUIT
- +59 SET ACKDIV=U_DIVARR
- +60 SET ACKX=""
- FOR
- SET ACKX=$ORDER(DIVARR(4,ACKX))
- if ACKX=""
- QUIT
- Begin DoDot:2
- +61 SET $PIECE(ACKDIV,U,1)=$PIECE(ACKDIV,U,1)+1
- SET ACKN=DIVARR(2,ACKX)
- +62 SET ACKDIV($PIECE(DIVARR(1,ACKN),U,1))=$PIECE(DIVARR(1,ACKN),U,1,3)_U
- End DoDot:2
- +63 ; if only one selected then save for spacebar recall
- +64 IF +$PIECE(ACKDIV,U,1)=1
- Begin DoDot:2
- +65 SET ACKIEN=$ORDER(ACKDIV(""))
- if 'ACKIEN
- QUIT
- +66 ; save for spacebar recall
- DO RECALL^DILFD(509850.83,ACKIEN_",1,",DUZ)
- End DoDot:2
- End DoDot:1
- GOTO DIVX
- +67 ;
- DIVX ; end
- +1 QUIT ACKDIV
- +2 ;
- +3 ;
- DIVHLP ; displays help text for the Division prompt
- +1 NEW X,DIWL,DIWR,DIWF
- +2 SET DIWL=1
- SET DIWR=80
- SET DIWF=""
- +3 SET X=" "
- DO ^DIWP
- +4 SET X=" Enter the name of a Division from the A&SP Site Parameters File."
- DO ^DIWP
- +5 SET X=" Enter '??' to see a list of the available Divisions, '^' to exit."
- DO ^DIWP
- +6 DO ^DIWW
- +7 QUIT
- LEADROLE(ACKVIEN) ; determine lead role for a visit
- +1 ; prior to version 3.0 all visits would be filed with a Lead Role
- +2 ; entered by the user (either the primary clinician, secondary
- +3 ; clinician or other prov). With ver 3.0 this field is no longer
- +4 ; populated and the lead role is the primary provider, or if absent
- +5 ; the secondary provider. In order to be backward compatible this
- +6 ; function will check the lead role field first. If it contains a
- +7 ; value then the visit must be pre-ver 3.0 and this code must be
- +8 ; the lead role selected by the user. If the lead role field is
- +9 ; empty then the visit must be post-ver 3.0 and so this function
- +10 ; will return either the primary or secondary provider.
- +11 NEW ACKSECV2,ACKTGT,ACKMSG,ACKLEAD,ACKIENS,ACKPRIM,ACKSCND,ACKSTUD,ACKMSG1,ACKTGT1
- +12 NEW ACK2
- +13 SET ACKIENS=ACKVIEN_","
- +14 DO GETS^DIQ(509850.6,ACKIENS,".25;.27;6","I","ACKTGT","ACKMSG")
- +15 ; Lead role (Pre V.3.)
- SET ACKLEAD=ACKTGT(509850.6,ACKIENS,.27,"I")
- +16 IF +ACKLEAD>0
- QUIT +ACKLEAD
- +17 ; Primary clinician
- SET ACKPRIM=ACKTGT(509850.6,ACKIENS,6,"I")
- +18 IF +ACKPRIM>0
- QUIT +ACKPRIM
- +19 ; Pre V.3 Sec'dry clinician
- SET ACKSECV2=ACKTGT(509850.6,ACKIENS,.25,"I")
- +20 IF +ACKSECV2>0
- QUIT +ACKSECV2
- +21 ;
- +22 DO LIST^DIC(509850.66,","_ACKVIEN_",",".01","I","*","","","","","","ACKTGT1","ACKMSG1")
- +23 SET ACKSCND=$ORDER(ACKTGT1("DILIST",1,""))
- +24 IF ACKSCND'=""
- SET ACKSCND=ACKTGT1("DILIST",1,ACKSCND)
- +25 ; First Secondary Provider V.3.
- QUIT +ACKSCND
- +26 ;
- ASPDIV(ACKDIV) ; returns true if ACKDIV is a valid ASP division
- +1 NEW ACKTGT,ACKMSG,ACKFND
- +2 ; look for the Division on the Site Parameters file
- +3 DO FIND^DIC(509850.83,",1,","","","`"_ACKDIV,1,"","","","ACKTGT","ACKMSG")
- +4 ; get number found
- +5 SET ACKFND=$PIECE($GET(ACKTGT("DILIST",0)),U,1)
- +6 QUIT (ACKFND=1)
- CLNDIV(ACKCLN) ; returns the ien of the division that the clinic is in.
- +1 QUIT $$GET1^DIQ(44,ACKCLN_",",3.5,"I")
- ASPCLN(ACKCLN) ; returns true if ACKCLN is a valid clinic for ASP
- +1 ; ACKCLN is the internal entry number from the hospital locations file
- +2 ; true returned if stop code is 203-Audiology, 204-Speech
- +3 ; if stop code is invalid then the credit stop code field must be either 203 or 204.
- +4 NEW ACKSTOP,ACKCRDT,ACKSC
- +5 ; get ien of stop code
- +6 SET ACKSTOP=$$GET1^DIQ(44,ACKCLN_",",8,"I")
- +7 ; bad clinic record
- IF ACKSTOP=""
- QUIT 0
- +8 ; get actual stop code
- +9 SET ACKSC=$$GET1^DIQ(40.7,ACKSTOP_",",1)
- +10 ; exit
- +11 ; audiology
- IF ACKSC=203
- QUIT 1
- +12 ; speech pathology
- IF ACKSC=204
- QUIT 1
- +13 ; get clinic credit stop code
- +14 SET ACKCRDT=$$GET1^DIQ(44,ACKCLN_",",2503,"I")
- +15 ; no credit stop code
- IF ACKCRDT=""
- QUIT 0
- +16 ; get actual stop code
- +17 SET ACKSC=$$GET1^DIQ(40.7,ACKCRDT_",",1)
- +18 ; exit
- +19 ; audiology
- IF ACKSC=203
- QUIT 1
- +20 ; speech pathology
- IF ACKSC=204
- QUIT 1
- +21 ; any other value is invalid
- QUIT 0
- UC(X) ; convert X to uppercase
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +2 ;