source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBA2785.m@ 861

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1DVBA2785 ;DLS/DEK - PATCH DRIVER ; 2/4/05
2 ;;2.7;AMIE;**85**;Apr 10, 1995
3 ; DBIA# External Reference(s)
4 ; 2051 $$FIND1^DIC
5 ; 2053 FILE^DIE
6 ; 10141 BMES^XPDUTL, MES^XPDUTL
7S S (C,I,J)=0,K=396.18,PA=3050120,PD=3050115,PN="85",PP=78 Q
8B D S,DF,K Q ;Pre-Init (Before)
9A D S,AD,K Q ;Post-Init (After)
10K D:J L(">>> Review the following errors <<<"),M
11 K C,I,J,K,N,LN,PA,PD,PN,PP,NM,FD
12 Q
13L(X) ;Log
14 S X=" "_$G(X)
15 I $D(XPDNM) D BMES^XPDUTL(X) Q
16 W !!,X
17 Q
18M ;Messages
19 I $D(XPDNM) D
20 .K C
21 .M C=^TMP("DVBA",$J)
22 .D MES^XPDUTL(.C)
23 E D
24 .S C=$Q(^TMP("DVBA",$J))
25 .F Q:C="" D
26 ..W !?3,@(C)
27 ..S C=$Q(@C)
28 K ^TMP("DIERR",$J),^TMP("DVBA",$J),^TMP($J,"DVBA")
29 Q
30DF ;Deactivate Forms
31 F S I=$O(^DVB(K,I)) Q:'I D CD(3,I)
32 Q
33CD(F,IEN) ;Change Data
34 S IEN=IEN_","
35 S FD(K,IEN,F)=$S(F=2:PA,1:PD)
36 I F=3 D
37 .S N=$G(^DVB(K,+IEN,2))
38 .S:N=""!(PD<$P(N,U)) FD(K,IEN,2)="@"
39 I F=2 D
40 .S FD(K,IEN,3)="@",N=$G(^DVB(K,+IEN,0))
41 .Q:$P(N,"~",2)=PP
42 .D WP($G(^DVB(K,+IEN,1,1,0)))
43 S FD(K,IEN,7)=$S(F=2:1,1:0)
44 D FILE^DIE(,"FD")
45 Q:'$D(^TMP("DIERR",$J))
46 S J=J+1
47 M ^TMP("DVBA",$J,J)=^TMP("DIERR",$J)
48 Q
49WP(T) Q:T=""
50 S ^TMP($J,"DVBA",1)=$P(T," ",1,4)
51 D WP^DIE(K,IEN,1,,"^TMP($J,""DVBA"")")
52 Q:'$D(^TMP("DIERR",$J))
53 S J=J+1
54 M ^TMP("DVBA",$J,J)=^TMP("DIERR",$J)
55 Q
56DL(DA,DIE,DR) ;
57 S DA=$$FIND1^DIC(K,,"O",DA)
58 D:DA ^DIE
59 Q
60AD ;Adjust Data
61 D DL("COLD INJURY PROTOCOL~85T1",K,".01///@")
62 F I=0:0 S I=$O(^DVB(K,I)) Q:'I D
63 .S N=$P(^(I,0),"~",2),C=C+1
64 .D:N=PN CD(2,I)
65 S I=$O(^DVB(K,"A"),-1),$P(^DVB(K,0),U,3,4)=I_U_C
66 ;Name-specific adjustments
67 F I=1:1 S LN=$P($T(NS+I),";;",2) Q:LN="" D
68 .S NM=$P(LN,U),FD=$P(LN,U,2)
69 .S C=$$FIND1^DIC(K,,"O",NM)
70 .D:C CD(FD,C)
71NS Q
72 ;;GENERAL MEDICAL EXAMINATION~78^2
73 ;;INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)~78^2
74 ;;MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)~78^2
75 ;;REVIEW EXAMINATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)~78^2
76 ;;AUDIO~78^2
77 ;;AUDIO~85^3
78 ;;AUDIO~85T1^3
79 ;;COLD INJURY PROTOCOL~85^3
80 ;;
Note: See TracBrowser for help on using the repository browser.