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