[613] | 1 | DVBA2785 ;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
|
---|
| 7 | S S (C,I,J)=0,K=396.18,PA=3050120,PD=3050115,PN="85",PP=78 Q
|
---|
| 8 | B D S,DF,K Q ;Pre-Init (Before)
|
---|
| 9 | A D S,AD,K Q ;Post-Init (After)
|
---|
| 10 | K D:J L(">>> Review the following errors <<<"),M
|
---|
| 11 | K C,I,J,K,N,LN,PA,PD,PN,PP,NM,FD
|
---|
| 12 | Q
|
---|
| 13 | L(X) ;Log
|
---|
| 14 | S X=" "_$G(X)
|
---|
| 15 | I $D(XPDNM) D BMES^XPDUTL(X) Q
|
---|
| 16 | W !!,X
|
---|
| 17 | Q
|
---|
| 18 | M ;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
|
---|
| 30 | DF ;Deactivate Forms
|
---|
| 31 | F S I=$O(^DVB(K,I)) Q:'I D CD(3,I)
|
---|
| 32 | Q
|
---|
| 33 | CD(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
|
---|
| 49 | WP(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
|
---|
| 56 | DL(DA,DIE,DR) ;
|
---|
| 57 | S DA=$$FIND1^DIC(K,,"O",DA)
|
---|
| 58 | D:DA ^DIE
|
---|
| 59 | Q
|
---|
| 60 | AD ;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)
|
---|
| 71 | NS 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 | ;;
|
---|