source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGFFP01.m@ 1166

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1DGFFP01 ; ALB/SCK - FUGITIVE FELON PROGRAM ROUTINE ; 11/08/2002
2 ;;5.3;Registration;**485**;Aug 13, 1993
3 ;
4 Q
5 ;
6GETPAT(ACTION) ; Retrieve patient name
7 N DIR,Y,X,DIRUT,RSLT
8 ;
9 S ACTION=$G(ACTION)
10 S RSLT=-1
11 S DIR(0)="PAO^2:EMZ"
12 S DIR("A")="Select Patient: "
13 S DIR("?")="Enter the name of a patient to update the Fugitive Felon Flag for."
14 I ACTION S DIR("S")="I $P($G(^DPT(Y,""FFP"")),U,1)=1"
15 D ^DIR K DIR
16 ;
17 I $D(DIRUT)
18 E S:+Y RSLT=Y
19 Q RSLT
20 ;
21CONT() ; Query to continue processing
22 N DIR,Y,X
23 ;
24 S DIR(0)="YA"
25 S DIR("A",1)=""
26 S DIR("A")="Process another felon entry? "
27 S DIR("B")="YES"
28 S DIR("?")="Enter 'YES' to continue processing, 'NO' to exit."
29 D ^DIR K DIR
30 Q +$G(Y)
31 ;
32CONFIRM(DGACT,DGPAT) ; Query to confirm set/clear the fugitive felon flag
33 N DIR,DIRUT,X,Y,DGABRT
34 ;
35 I "S"[DGACT D I $G(DGABRT) Q 0
36 . I $D(^DPT("AXFFP",1,+DGPAT)) D Q
37 . . W !?2,"The Fugitive Felon Flag is already set..."
38 . . S DGABRT=1
39 . S DIR("A",1)=""
40 . S DIR("A",2)=" >> This will set the Fugitive Felon Flag for "_$P(DGPAT,U,2)_"."
41 . S DIR("A")=" >> Continue with setting the flag? "
42 . S DIR("?")="Enter 'YES' to set the flag, 'NO' to skip."
43 ;
44 I "C"[DGACT D
45 . S DIR("A",1)=""
46 . S DIR("A",2)=" >> This will clear the Fugitive Felon Flag for "_$P(DGPAT,U,2)_"."
47 . S DIR("A")=" >> Continue with clearing the flag? "
48 . S DIR("?")="Enter 'YES' to set the flag, 'NO' to skip."
49 ;
50 S DIR(0)="YA",DIR("B")="NO"
51 D ^DIR K DIR
52 Q $G(Y)
53 ;
54SETFLAG ; Set the Fugitive Felon Flag
55 N DGPAT,DGFDA,DGERR
56 ;
57SET1 S DGPAT=$$GETPAT
58 I +DGPAT<0 G QSET
59 I $$CONFIRM("S",DGPAT) D
60 . S DGFDA(1,2,+DGPAT_",",1100.01)=1
61 . D FILE^DIE("","DGFDA(1)","DGERR")
62 . I $D(DGERR) D MSG^DIALOG("EAW","",70,5,"DGERR")
63 ;
64 I '$$CONT G QSET
65 G SET1
66QSET Q
67 ;
68CLRFLAG ; Clear the Fugitive Felon Flag
69 N DGPAT,DGFDA,DGERR
70 ;
71CLR1 S DGPAT=$$GETPAT(1)
72 I +DGPAT<0 G QCLR
73 I $$CONFIRM("C",DGPAT) D
74 . S DGFDA(1,2,+DGPAT_",",1100.01)="@"
75 . D FILE^DIE("","DGFDA(1)","DGERR")
76 . I $D(DGERR) D MSG^DIALOG("EAW","",70,5,"DGERR")
77 ;
78 I '$$CONT G QCLR
79 G CLR1
80QCLR Q
81 ;
82DD(DFN) ; CALLED BY AUFFP X-REF ON THE FUGITIVE FELON FLAG FIELD
83 ; #1100.01 IN THE PATIENT FILE #2.
84 ;
85 ; This procedure will set the following fields:
86 ; FFF ENTERED BY, Field #1100.02
87 ; FFF DATE ENTERED, Field #1100.03
88 ; FFF REMOVED BY, Field 1100.04
89 ; FFF DATE REMOVED,, Field 1100.05
90 ; FFF REMOVAL REMARKS, Field 1100.09
91 ;
92 ; Check Input
93 I +$G(DFN),$D(^DPT(DFN,0))
94 E Q
95 ;
96 N DGFDA,DGIEN,DGOLD
97 ;
98 S DGIEN=DFN_","
99 S DGOLD=$G(^DPT(DFN,"FFP"))
100 I +DGOLD D
101 . I $P(DGOLD,"^",2)>0
102 . E D
103 . . S DGFDA(1,2,DGIEN,1100.02)=DUZ
104 . . S DGFDA(1,2,DGIEN,1100.03)=$$NOW^XLFDT
105 . I $P(DGOLD,"^",4)>0 D
106 . . S DGFDA(1,2,DGIEN,1100.04)="@"
107 . . S DGFDA(1,2,DGIEN,1100.05)="@"
108 . . S DGFDA(1,2,DGIEN,1100.09)="@"
109 E D
110 . ;S DGFDA(1,2,DGIEN,1100.02)="@"
111 . ;S DGFDA(1,2,DGIEN,1100.03)="@"
112 . S DGFDA(1,2,DGIEN,1100.04)=DUZ
113 . S DGFDA(1,2,DGIEN,1100.05)=$$NOW^XLFDT
114 . S DGFDA(1,2,DGIEN,1100.09)=$$RMRK
115 ;
116 D:$D(DGFDA) FILE^DIE("","DGFDA(1)")
117 Q
118 ;
119RMRK() ;
120 N DIR
121 ;
122AGN S DIR(0)="FA",DIR("A",1)=" >> Enter a brief remark on why this flag is being cleared."
123 S DIR("A",2)=" >> This is a required field."
124 S DIR("A")=" --> "
125 S DIR("?",1)=" Remark must be between 2-80 characters. Please be brief"
126 S DIR("?")=" This field is required when clearing the Fugitive Felon Flag"
127 D ^DIR K DIR
128 I $L(Y)>80!($L(Y)<2) K Y G AGN
129 Q $G(Y)
Note: See TracBrowser for help on using the repository browser.