source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQASU7.m@ 703

Last change on this file since 703 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1ACKQASU7 ;HCIOFO/AG - New/Edit Visit Utilities ; 04/01/99
2 ;;3.0;QUASAR;;Feb 11, 2000
3 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;
5 ;
6SHOWPCE(ACKGBL) ; display errors from COPYPCE stored in @ACKGBL
7 ; this routine displays on the screen any errors found in the global
8 ; referenced by ACKGBL that were created by COPYPCE^ACKQASU4.
9 ; format for global is @ACKGBL=number or errors
10 ; @ACKGBL@(n)=field^int^ext^message
11 ; returns:- 0 - continue, 1 - user typed '^' to exit
12 N ACKERR,ACKECT,ACKLN,ACKTMP,ACKFLD,ACKINT,ACKEXT,ACKMSG,ACKTXT,ACKLF
13 N DIRUT,ACKTAB,ACKLEN
14 ;
15 ; get number of errors, initialise line counter
16 S ACKERR=@ACKGBL,ACKLN=0
17 ;
18 ; show header
19 W !!?2,"ERROR - The following errors occurred while copying the PCE Visit"
20 W !?2,"data into QUASAR. The fields in error are displayed below with the"
21 W !?2,"reason they were rejected.",!
22 S ACKLN=6
23 ;
24 ; display the errors
25 F ACKECT=1:1:ACKERR D Q:$D(DIRUT)
26 . S ACKTMP=@ACKGBL@(ACKECT)
27 . S ACKFLD=$P(ACKTMP,U,1),ACKINT=$P(ACKTMP,U,2),ACKEXT=$P(ACKTMP,U,3)
28 . S ACKDTA=$S(ACKEXT="":ACKINT,1:ACKEXT)
29 . S ACKTAB=$S($L(ACKDTA)>19:35,1:13+$L(ACKDTA)+2+5\5*5),ACKLEN=80-ACKTAB
30 . W !?2,ACKFLD_":",?13,$E(ACKDTA,1,20)
31 . S ACKMSG=$P(ACKTMP,U,4),ACKLF=0
32 . F Q:ACKMSG="" D Q:$D(DIRUT)
33 . . S ACKTXT=$E(ACKMSG,1,ACKLEN) D ; reset TXT (word wrap)
34 . . . I ($E(ACKTXT,ACKLEN)?1P)!($E(ACKMSG,ACKLEN+1)?1P) Q
35 . . . S ACKI=0 I $L(ACKTXT)=ACKLEN F ACKI=ACKLEN:-1:0 Q:$E(ACKTXT,ACKI)?1P
36 . . . I ACKI S ACKTXT=$E(ACKTXT,1,ACKI) Q
37 . . W:ACKLF ! W ?ACKTAB,ACKTXT S ACKLF=1
38 . . S ACKLN=ACKLN+1 D PAUSE Q:$D(DIRUT)
39 . . S ACKMSG=$P(ACKMSG,ACKTXT,2,999)
40 . . F Q:$E(ACKMSG)'=" " S ACKMSG=$E(ACKMSG,2,999)
41 ;
42 ; all done
43 I '$D(DIRUT) S ACKLN=0 D PAUSE
44 ; return 1 if user chose to quit, 0 if they didn't
45 Q $D(DIRUT)
46 ;
47PAUSE ;
48 Q:ACKLN#15'=0
49 W !!
50 K DIR S DIR(0)="E" D ^DIR K DIR ; Return to Continue '^' to Exit
51 W !
52 Q
53 ;
54ACKAPMNT(ACKVD,ACKVTME,ACKCLIN,ACKPAT) ;
55 ;
56 ; //First checks to see if Patient is an Inpatient if they are then
57 ; //dont display this message.
58 ; Checks to see if the visit entered corresponds to a Visit Within
59 ; Appointment Management. If does'nt a warning is displayed - the
60 ; can continue or quit. This is to remind/encorage users to enter
61 ; visits first through Appointment Management then pick them up
62 ; in Quasar.
63 ;
64 ; N VAIN D INP^VADPT I $P(VAIN(4),U,2)'="" Q 1
65 ;
66 N ACKK1,ACKT,ACKOKAY
67 I ACKVTME="" G MESSAG
68 ;
69 S DFN=ACKPAT,VASD("C",ACKCLIN)="",VASD("T")=ACKVD,VASD("F")=ACKVD
70 S VASD("W")="129"
71 K ^UTILITY("VASD",$J) D SDA^VADPT ; Call appointment utility
72 I '$D(^UTILITY("VASD",$J)) G MESSAG ; Nothing returned=No appointment
73 ;
74 S ACKK1="",ACKOKAY=0
75 F S ACKK1=$O(^UTILITY("VASD",$J,ACKK1)) Q:ACKK1=""!(ACKOKAY) D
76 . S ACKT=$P(^UTILITY("VASD",$J,ACKK1,"I"),U,1)
77 . S ACKT=$P(ACKT,".",2)
78 . I ACKT=ACKVTME S ACKOKAY=1
79 K ^UTILITY("VASD",$J)
80 ;
81 I ACKOKAY Q 1
82 ;
83MESSAG ;
84 W !!!,"WARNING -",!
85 W !,"You are Creating a Visit that does not exist within Appointment Management."
86 W !,"This Visit will not be displayed within Appointment Management.",!
87 ;
88 N DIR,DUOUT,DTOUT,DIRUT
89OK2 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to Continue "
90 S DIR("?")="Answer YES to continue with New Visit Entry or NO to quit."
91 D ^DIR
92 I Y?1"^"1.E W !,"Jumping not allowed.",! G OK2
93 S:$D(DIRUT) Y=0
94 S:$D(DTOUT) Y=0
95 Q Y
96 ;
Note: See TracBrowser for help on using the repository browser.