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

ACKQASU2.m

Go to the documentation of this file.
  1. ACKQASU2 ;HCIOFO/BH-NEW/EDIT VISIT QUASAR UTILITIES ; 04/01/99
  1. ;;3.0;QUASAR;**1**;Feb 11, 2000
  1. ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
  1. ;
  1. ;
  1. ADD S ACKCNT=ACKCNT+1 Q
  1. ;
  1. ;
  1. ;
  1. POST(ACKVIEN) ;
  1. K DIRUT,DTOUT
  1. ;
  1. N ACKEXPT,ACKK1,ACKK2,ACKARR,ACK,ACKSC,VAEL,ACKVSC,ACKVAO,ACKVRAD,ACKVENV
  1. ;
  1. ; Clear away Update PCE Problem list and Diag provider if invalid
  1. N ACKPROB,ACKDD,ACKDREC,ACKDUP,ACKDPROV,ACKDIAG
  1. S ACKDIAG=0
  1. S ACKPROB=$$PROB^ACKQUTL4(ACKPCE,ACKDIV)
  1. F S ACKDIAG=$O(^ACK(509850.6,ACKVIEN,1,ACKDIAG)) Q:'ACKDIAG D
  1. . S ACKDREC=$G(^ACK(509850.6,ACKVIEN,1,ACKDIAG,0)) Q:'ACKDREC
  1. . S ACKDUP=$P(ACKDREC,"^",3)
  1. . S ACKDPROV=$P(ACKDREC,"^",4)
  1. . I 'ACKPROB D Q
  1. . . I ACKDUP'=""!(ACKDPROV'="") D
  1. . . . K ACKDD
  1. . . . S ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.13)=""
  1. . . . S ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.14)=""
  1. . . . D FILE^DIE("","ACKDD","") K ACKDD
  1. . I ACKPROB D Q
  1. . . I 'ACKDUP,ACKDPROV'="" D
  1. . . . K ACKDD
  1. . . . S ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.14)=""
  1. . . . S ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.13)=""
  1. . . . D FILE^DIE("","ACKDD","") K ACKDD
  1. ;
  1. ;------------------------------------------------
  1. D ELIG^VADPT S ACKSC=$P(VAEL(3),U,1) K VAEL
  1. ;
  1. GETDATA D GETS^DIQ(509850.6,ACKVIEN,"20;25;30;35","I","ACK")
  1. ;
  1. S ACKVSC=ACK(509850.6,ACKVIEN_",",20,"I")
  1. S ACKVAO=ACK(509850.6,ACKVIEN_",",25,"I")
  1. S ACKVRAD=ACK(509850.6,ACKVIEN_",",30,"I")
  1. S ACKVENV=ACK(509850.6,ACKVIEN_",",35,"I")
  1. ;
  1. K ACK
  1. ;
  1. NULL ; NUll out fields that should not bo present or have been set
  1. ; incorrectly
  1. ;
  1. I ACKSC=0,ACKVSC'="" S ACK(509850.6,ACKVIEN_",",20)="" S ACKVSC=""
  1. ;
  1. I ACKAO=0,ACKVAO'="" S ACK(509850.6,ACKVIEN_",",25)=""
  1. I ACKRAD=0,ACKVRAD'="" S ACK(509850.6,ACKVIEN_",",30)=""
  1. I ACKENV=0,ACKVENV'="" S ACK(509850.6,ACKVIEN_",",35)=""
  1. ;
  1. I ACKSC=1,ACKVSC=1,ACKVAO'="" S ACK(509850.6,ACKVIEN_",",25)=""
  1. I ACKSC=1,ACKVSC=1,ACKVRAD'="" S ACK(509850.6,ACKVIEN_",",30)=""
  1. I ACKSC=1,ACKVSC=1,ACKVENV'="" S ACK(509850.6,ACKVIEN_",",35)=""
  1. I $D(ACK) D FILE^DIE("","ACK") K ACK
  1. ;
  1. D CHKVST^ACKQUTL8(ACKVIEN,.ACKARR,1)
  1. ;
  1. I ACKARR=0 D MINIMUM G EXIT ; Minimum data not entered
  1. ;
  1. I ACKARR=-1 D CORRUPT,DELETE S ACKOUT=2 ; Corrupt
  1. ;
  1. I ACKARR=3 S ACKOUT=1 G EXIT ; Everything is okay
  1. ;
  1. I 'ACKPCE,ACKARR=2 S ACKOUT=1 G EXIT ; Interface off and no Quasar
  1. ; ; errors - Everything is okay
  1. ;
  1. I ACKPCE D
  1. . D PCE
  1. . S ACKK1="" F S ACKK1=$O(ACKARR(1,ACKK1)) Q:ACKK1="" D
  1. . . W !," ",ACKARR(1,ACKK1)
  1. . S ACKK2="" F S ACKK2=$O(ACKARR(2,ACKK2)) Q:ACKK2="" D
  1. . . W !," ",ACKARR(2,ACKK2)
  1. . S ACKEXPT=$$EXPT(ACKVIEN)
  1. . W !! D CHOICE1 W !!
  1. ;
  1. I 'ACKPCE D
  1. . D QUASAR
  1. . S ACKK1="" F S ACKK1=$O(ACKARR(1,ACKK1)) Q:ACKK1="" D
  1. . . W !," ",ACKARR(1,ACKK1)
  1. . W !! D CHOICE W !!
  1. ;
  1. EXIT ; One way out
  1. Q ACKOUT
  1. ;
  1. ;
  1. MINIMUM ; Minimum Data not entered. If New Visit user can either delete or
  1. ; re-edit the visit if user is editing a visit user only has option
  1. ; to re-edit the visit.
  1. ;
  1. D DISPLAY
  1. I ACKVISIT="NEW" D Q
  1. . K DIR
  1. . S DIR("A")="Enter RETURN to Re-Edit Visit or '^' to Quit and Delete"
  1. . S DIR(0)="E" D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DIRUT) S X="^" ; Time out or Quit
  1. . I X="^" S ACKOUT=2 D DELETE Q
  1. . S ACKOUT=0 Q ; Entered <Return>
  1. ;
  1. I ACKVISIT="EDIT" D Q
  1. . K DIR
  1. . S DIR("?")="This option will not Quit until Quasars Minimum Data Requirements have been entered"
  1. . S DIR("A")="Press RETURN to Re-edit Visit",DIR(0)="E"
  1. . D ^DIR
  1. . S ACKOUT=0 Q
  1. ;
  1. ;
  1. DELETE ; Delete the entry
  1. ;
  1. W !!,$C(7),"<<INCOMPLETE RECORD DELETED!!>>",!!
  1. S DIK="^ACK(509850.6,",DA=ACKVIEN D ^DIK
  1. Q
  1. ;
  1. ;
  1. CORRUPT ; Display corrupt data message
  1. ;
  1. W !!,"ERROR - This record has become corrupted.",!
  1. ;
  1. Q
  1. ;
  1. QUASAR ; Display Quasar heading and missing fields
  1. ;
  1. W !!," WARNING - ",!
  1. W " The following are fields required by QUASAR that have not been entered.",!
  1. W " Enter <RETURN> to re-enter this function or '^' to quit.",!!
  1. ;
  1. Q
  1. ;
  1. PCE ; Display PCE missing fields
  1. ;
  1. W @IOF
  1. W " WARNING - ",!!
  1. W " The following are fields required by QUASAR & PCE that have not been entered.",!
  1. Q
  1. ;
  1. PCE1 W !," '^' Quit & File the A&SP visit but do not send incomplete A&SP"
  1. W !," visit to PCE. Or,"
  1. ;
  1. Q
  1. ;
  1. CHOICE ; Display choice - either enter '^' to quit entry or <Return> to
  1. ; re-enter the template
  1. ;
  1. K DIR S DIR(0)="E" D ^DIR K DIR
  1. I +Y=1 S ACKOUT=0
  1. I +Y=0 S ACKOUT=1
  1. S:$D(DIRUT) ACKOUT=1
  1. K DIRUT,DTOUT
  1. Q
  1. ;
  1. CHOICE1 ; Prompt for PCE choice - An Exception may not be set when the PCE Inte-
  1. ; -face is on so dont prompt user with 'Send to PCE' options if no
  1. ; exception is present (i.e. ACKEXPT=0).
  1. ;
  1. ; If EXCEPTION '^' - Quit but not send to PCE
  1. ; R - Re-enter the template
  1. ; C - Continue send with errors
  1. ; '^' - Returns 2 C - Returns 1 R - Returns 0
  1. ;
  1. ; If not EXCEPTION '^' - Quit
  1. ; R - Re-enter the template
  1. ; C - Continue file with errors
  1. ; '^' & C - Returns 2 R - Returns 0
  1. ;
  1. DISP I ACKEXPT D PCE1
  1. S DIR("A")=" (C)ontinue or (R)enter "
  1. S DIR("B")="R"
  1. I ACKEXPT S DIR("?")=" Enter 'R' to Re-enter this function and amend data, 'C' to Continue and send incomplete A&SP visit data to PCE or '^' to exit without sending to PCE."
  1. I ACKEXPT'=1 S DIR("?")=" Enter 'R' to Re-enter this function and amend data or 'C' to Continue and file incomplete"
  1. I ACKEXPT S DIR(0)="S^R:Re-enter this function & amend data;C:Continue & send incomplete A&SP visit data to PCE;"
  1. I ACKEXPT'=1 S DIR(0)="S^R:Re-enter this function & amend data;C:Continue & file incomplete;"
  1. D ^DIR K DIR
  1. S:$D(DTOUT) X=U
  1. S:$D(DIRUT) ACKOUT=2
  1. I ACKEXPT I X="c"!(X="C") S ACKOUT=1
  1. I ACKEXPT'=1 I X="c"!(X="C") S ACKOUT=2
  1. I X="r"!(X="R") S ACKOUT=0
  1. I X="^" S ACKOUT=2
  1. ;
  1. Q
  1. ;
  1. UTLAUD ;
  1. N ACK,ACKRAV,ACKLAV,ACKI,ACKR1,ACKR2,ACKR3,ACKR4,ACKL1,ACKL2,ACKL3,ACKL4
  1. N ACKAR
  1. ; Sets previous vist audiometric data into file
  1. ;
  1. I $L($G(ACKLAMD))>7 D Q
  1. . F ACKI=1:1:16 S $P(^ACK(509850.6,ACKVIEN,4),U,ACKI)=$P(ACKLAMD,U,ACKI+1)
  1. ;
  1. ;
  1. ; Calculates the average of the scores and sets the results into
  1. ; visit file
  1. ;
  1. D VALUES
  1. ;
  1. ; Cannot calculate average if a null value exists
  1. I ACKR1=""!(ACKR2="")!(ACKR3="")!(ACKR4="") G LEFT
  1. S ACKRAV=ACKR1+ACKR2+ACKR3+ACKR4/4+.5\1 S:ACKRAV<0 ACKRAV=0
  1. S ACKAR(509850.6,ACKVIEN_",","4.06")=ACKRAV
  1. ;
  1. LEFT ; Cannot calculate average if a null value exists
  1. I ACKL1=""!(ACKL2="")!(ACKL3="")!(ACKL4="") Q
  1. S ACKLAV=ACKL1+ACKL2+ACKL3+ACKL4/4+.5\1 S:ACKLAV<0 ACKLAV=0
  1. S ACKAR(509850.6,ACKVIEN_",","4.12")=ACKLAV
  1. D FILE^DIE("K","ACKAR") K ACKAR
  1. ;
  1. Q
  1. ;
  1. VALUES ; Get value for calculation
  1. K ACK
  1. D GETS^DIQ(509850.6,ACKVIEN,"4.02;4.03;4.04;4.05;4.08;4.09;4.1;4.11","I","ACK")
  1. ;
  1. S ACKR1=ACK(509850.6,ACKVIEN_",",4.02,"I")
  1. S ACKR2=ACK(509850.6,ACKVIEN_",",4.03,"I")
  1. S ACKR3=ACK(509850.6,ACKVIEN_",",4.04,"I")
  1. S ACKR4=ACK(509850.6,ACKVIEN_",",4.05,"I")
  1. ;
  1. S ACKL1=ACK(509850.6,ACKVIEN_",",4.08,"I")
  1. S ACKL2=ACK(509850.6,ACKVIEN_",",4.09,"I")
  1. S ACKL3=ACK(509850.6,ACKVIEN_",",4.1,"I")
  1. S ACKL4=ACK(509850.6,ACKVIEN_",",4.11,"I")
  1. ;
  1. K ACK
  1. Q
  1. ;
  1. EXPT(ACKVIEN) ; Passes back 1 or zero depending if visit has an Exception
  1. ; entry set up.
  1. N ACKEX
  1. S ACKEX=$$GET1^DIQ(509850.6,ACKVIEN_",",900,"I") I ACKEX="" Q 0
  1. I '$D(^ACK(509850.6,"AEX",ACKEX,ACKVIEN)) Q 0
  1. Q 1
  1. ;
  1. ;
  1. DISPLAY ;
  1. W !!,"The following field(s) are required by QUASAR but have not been entered.",!!
  1. I $$GET1^DIQ(509850.6,ACKVIEN_",",5)="" W " CDR Account",!
  1. I $$GET1^DIQ(509850.6,ACKVIEN_",",55)="" W " Appointment Time",!
  1. W !!
  1. Q
  1. ;