source: WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLSAVE.m@ 613

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

initial load of WorldVistAEHR
File size: 5.4 KB
Line 
1GMPLSAVE ; SLC/MKB/KER -- Save Problem List data ; 03/13/2008
2 ;;2.0;Problem List;**26,31,35**;Aug 25, 1994;Build 26
3 ;
4 ; External References
5 ; DBIA 10018 ^DIE
6 ; DBIA 10013 ^DIK
7 ; DBIA 10013 IX1^DIK
8 ; DBIA 10103 $$HTFM^XLFDT
9 ;
10EN ; Save Changes made to Existing Problem
11 N FLD,NOW,CHNGE,I,NIFN,TEXT,OLDTEXT,FAC,NODE,AUDITED,DR,DA,DIE,DIK
12 S:'GMPORIG(.01) GMPORIG(.01)=$$NOS^GMPLX
13 S:'GMPFLD(.01) GMPFLD(.01)=$$NOS^GMPLX
14 S:$D(GMPFLD(.01)) GMPFLD(.01)=+GMPFLD(.01)
15 S:$P(+GMPFLD(.01),U)=-1 GMPFLD(.01)=$$NOS^GMPLX ;chk for error from ICD
16 S:'GMPORIG(1.01) GMPORIG(1.01)="1^Unresolved"
17 S:'GMPFLD(1.01) GMPFLD(1.01)="1^Unresolved"
18 S:'GMPFLD(.05) I=$P(GMPFLD(.05),U,2),GMPFLD(.05)=$$PROVNARR^GMPLX(I,+GMPFLD(1.01))
19 S NOW=$$HTFM^XLFDT($H),AUDITED=0
20 S DR="1.02////"_$S('$D(GMPLUSER):"T",1:GMPFLD(1.02))
21 I GMPORIG(1.02)="T",GMPFLD(1.02)="P" D
22 . S CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ
23 . D AUDIT^GMPLX(CHNGE,"")
24 I $P($G(GMPORIG(.12)),U)="I",$P(GMPFLD(.12),U)="A" D REACTV S AUDITED=1
25 I +$G(GMPORIG(1.01))'=(+GMPFLD(1.01)) D REFORM S AUDITED=1
26 S GMPFLD(.01)=+GMPFLD(.01) ;to remove text left by ?? lex (~)
27 F FLD=.01,.05,.12,.13,1.01,1.05,1.06,1.07,1.08,1.09,1.1,1.11,1.12,1.13,1.14,1.15,1.16,1.17,1.18 D
28 . Q:'$D(GMPFLD(FLD)) Q:$P($G(GMPORIG(FLD)),U)=$P($G(GMPFLD(FLD)),U)
29 . S DR=DR_";"_FLD_"////"_$S($P(GMPFLD(FLD),U)'="":$P(GMPFLD(FLD),U),1:"@")
30 . Q:AUDITED S CHNGE=GMPIFN_U_FLD_U_NOW_U_DUZ_U_$P(GMPORIG(FLD),U)_U_$P(GMPFLD(FLD),U)_"^^"_+$G(GMPROV)
31 . D AUDIT^GMPLX(CHNGE,"")
32 S DA=GMPIFN,DIE="^AUPNPROB(" D ^DIE S GMPSAVED=1
33NOTES ; Save Changes to Notes
34 F I=0:0 S I=$O(GMPORIG(10,I)) Q:I'>0 I GMPORIG(10,I)'=GMPFLD(10,I) D
35 . S NIFN=+GMPFLD(10,I),FAC=$P(GMPFLD(10,I),U,2),TEXT=$P(GMPFLD(10,I),U,3),OLDTEXT=$P(GMPORIG(10,I),U,3)
36 . S NODE=$G(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0))
37 . I TEXT'="" S $P(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0),U,3)=TEXT D
38 .. I TEXT=OLDTEXT Q
39 .. S CHNGE=GMPIFN_"^1101^"_NOW_U_DUZ_"^C^^Note Modified^"_+$G(GMPROV)
40 . I TEXT=OLDTEXT Q
41 . I TEXT="" S CHNGE=GMPIFN_"^1101^"_NOW_U_DUZ_"^A^^Deleted Note^"_+$G(GMPROV)
42 . D AUDIT^GMPLX(CHNGE,NODE)
43 . I TEXT="" D
44 .. S DIK="^AUPNPROB("_GMPIFN_",11,"_FAC_",11,"
45 .. S DA(2)=GMPIFN,DA(1)=FAC,DA=NIFN D ^DIK
46 I $D(GMPFLD(10,"NEW"))>9 D NEWNOTE
47EXIT ; Quit Saving Changes
48 D:$G(GMPSAVED) DTMOD^GMPLX(GMPIFN)
49 Q
50 ;
51REFORM ; Audit Entry that has been Reformulated
52 S CHNGE=GMPIFN_"^1.01^"_NOW_U_DUZ_U_+GMPORIG(1.01)_U_+GMPFLD(1.01)_"^Reformulated^"_+$G(GMPROV)
53 S NODE=$G(^AUPNPROB(GMPIFN,0))_U_$G(^AUPNPROB(GMPIFN,1))
54 D AUDIT^GMPLX(CHNGE,NODE)
55 Q
56 ;
57REACTV ; Audit Entry that has been Reactivated
58 S CHNGE=GMPIFN_"^.12^"_NOW_U_DUZ_"^I^A^Reactivated^"_+$G(GMPROV)
59 S NODE=$G(^AUPNPROB(GMPIFN,0))_U_$G(^AUPNPROB(GMPIFN,1))
60 D AUDIT^GMPLX(CHNGE,NODE)
61 Q
62 ;
63NEW ; Save Collected Values in new Problem Entry
64 ; Output DA (left defined)
65 N DATA,APCDLOOK,APCDALVR,NUM,I,DIK,GMPIFN,X
66 S:'GMPFLD(.01) GMPFLD(.01)=$$NOS^GMPLX
67 S:$P(+GMPFLD(.01),U)=-1 GMPFLD(.01)=$$NOS^GMPLX ;chk for error from ICD
68 S GMPFLD(.01)=+GMPFLD(.01) ;to remove text left by ?? lex (~)
69 S:'GMPFLD(1.01) GMPFLD(1.01)="1^Unresolved"
70 S:'GMPFLD(.05) X=$P(GMPFLD(.05),U,2),GMPFLD(.05)=$$PROVNARR^GMPLX(X,+GMPFLD(1.01))
71 S DA=$$NEWPROB(+GMPFLD(.01),+GMPDFN) Q:DA'>0
72 S NUM=$$NEXTNMBR(+GMPDFN,+GMPVAMC),GMPSAVED=1 S:'NUM NUM=""
73 ; Set Node 0
74 S DATA=^AUPNPROB(DA,0)_U_DT_"^^"_$P(GMPFLD(.05),U)_U_+GMPVAMC_U_+NUM_U_DT_"^^^^"_$P(GMPFLD(.12),U)_U_$P(GMPFLD(.13),U)
75 S ^AUPNPROB(DA,0)=DATA
76 ; Set Node 1
77 S DATA=$P(GMPFLD(1.01),U) F I=1.02:.01:1.18 S DATA=DATA_U_$P($G(GMPFLD(+I)),U)
78 S ^AUPNPROB(DA,1)=DATA
79 ; Set X-Refs
80 S DIK="^AUPNPROB(",(APCDLOOK,APCDALVR)=1 D IX1^DIK
81 I $D(GMPFLD(10,"NEW"))>9 S GMPIFN=DA D NEWNOTE
82 Q
83 ;
84NEWPROB(ICD,DFN) ; Creates New Problem Entry in file #9000011
85 N I,HDR,LAST,TOTAL,DA
86 L +^AUPNPROB(0):1 I '$T D Q -1
87 . W !!,"Someone else is currently editing this file."
88 . W !,"Please try again later.",!
89 S HDR=$G(^AUPNPROB(0)) Q:HDR="" -1
90 S LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4)
91 F I=(LAST+1):1 Q:'$D(^AUPNPROB(I,0))
92 S DA=I,^AUPNPROB(DA,0)=ICD_U_DFN
93 S ^AUPNPROB("B",ICD,DA)="",^AUPNPROB("AC",DFN,DA)=""
94 S $P(^AUPNPROB(0),U,3,4)=DA_U_(TOTAL+1) L -^AUPNPROB(0)
95 Q DA
96 ;
97NEWNOTE ; Creates New Note Entries for Problem
98 ; Requires GMPIFN Pointer to Problem
99 ; GMPROV Current Provider
100 ; GMPVAMC Facility
101 N HDR,LAST,TOTAL,I,FAC,NIFN
102 L +^AUPNPROB(GMPIFN,11):1 I '$T Q
103 S FAC=+$O(^AUPNPROB(GMPIFN,11,"B",GMPVAMC,0)) I 'FAC D
104 . S:'$D(^AUPNPROB(GMPIFN,11,0)) ^(0)="^9000011.11PA^^"
105 . S HDR=^AUPNPROB(GMPIFN,11,0),LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4)
106 . F I=(LAST+1):1 Q:'$D(^AUPNPROB(GMPIFN,11,I,0))
107 . S ^AUPNPROB(GMPIFN,11,I,0)=GMPVAMC,^AUPNPROB(GMPIFN,11,"B",GMPVAMC,I)=""
108 . S FAC=I,$P(^AUPNPROB(GMPIFN,11,0),U,3,4)=FAC_U_(TOTAL+1)
109 I FAC'>0 G NNQ
110NN1 ; Get New Note
111 S:'$D(^AUPNPROB(GMPIFN,11,FAC,11,0)) ^(0)="^9000011.1111IA^^"
112 S HDR=^AUPNPROB(GMPIFN,11,FAC,11,0),LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4)
113 F I=(LAST+1):1 Q:'$D(^AUPNPROB(GMPIFN,11,FAC,11,I,0))
114 S NIFN=I
115 F I=0:0 S I=$O(GMPFLD(10,"NEW",I)) Q:I'>0 D
116 . S ^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0)=NIFN_"^^"_GMPFLD(10,"NEW",I)_"^A^"_DT_U_+$G(GMPROV)
117 . S ^AUPNPROB(GMPIFN,11,FAC,11,"B",NIFN,NIFN)=""
118 . S TOTAL=TOTAL+1,LAST=NIFN,NIFN=NIFN+1
119 S $P(^AUPNPROB(GMPIFN,11,FAC,11,0),U,3,4)=LAST_U_TOTAL
120NNQ ; Quit Getting New Notes
121 L -^AUPNPROB(GMPIFN,11)
122 Q
123 ;
124NEXTNMBR(DFN,VAMC) ; Returns Next Available Problem Number
125 N I,J,NUM S NUM=1,I="" I '$D(^AUPNPROB("AA",DFN,VAMC)) Q NUM
126 F S I=$O(^AUPNPROB("AA",DFN,VAMC,I)) Q:I="" S J=$E(I,2,999),NUM=+J
127 S NUM=NUM+1
128 Q NUM
Note: See TracBrowser for help on using the repository browser.