| [613] | 1 | DGRP6CL1 ;ALB/TMK - REGISTRATION SCREEN 6 FLDS Conflict loc (cont) ; 09/15/2005
|
|---|
| 2 | ;;5.3;Registration;**689,764**;Aug 13, 1993;Build 16
|
|---|
| 3 | ;
|
|---|
| 4 | DELCFL(DFN) ; Delete all existing OEF/OIF episodes for a patient
|
|---|
| 5 | ; DFN = patient ien
|
|---|
| 6 | N DA,DIK,X,Y,DG
|
|---|
| 7 | S DG=0 F S DG=$O(^DPT(DFN,.3215,DG)) Q:'DG I $G(^(DG,0))'="" S DA(1)=DFN,DA=DG,DIK="^DPT("_DA(1)_",.3215," D ^DIK
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | EDCFL(DFN,IEN,VEDIT) ; Edit OEF/OIF conflict from/to dates only or delete entry
|
|---|
| 11 | N DIE,DA,X,Y,DR,DIPA
|
|---|
| 12 | I $G(VEDIT)=2 W !!,"WARNING - THIS CONFLICT IS INCONSISTENT WITH MILITARY SERVICE DATA",!
|
|---|
| 13 | Q:$P($G(^DPT(DFN,.3215,IEN,0)),U,4)
|
|---|
| 14 | S DIPA(.01)=+$G(^DPT(DFN,.3215,IEN,0))
|
|---|
| 15 | S DA(1)=DFN,DA=IEN,DIE="^DPT("_DA(1)_",.3215,",DR=".05///NOW;@10;.01;I X'=DIPA(.01) S Y=""@50"";.02R;.03R;S Y=""@99"";@50;D NOCHG^DGRP6CL1;.01////"_$G(DIPA(.01))_";S Y=""@10"";@99"
|
|---|
| 16 | D ^DIE
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | ADDCFL(DFN,DGY,DGCONF,SRC) ; Add a new OEF/OIF conflict entry
|
|---|
| 20 | ; DFN = patient ien
|
|---|
| 21 | ; DGY = 1 for OIF, 2 for OEF, 3 for UNKNOWN OEF/OIF
|
|---|
| 22 | ; DGCONF = the conflict record being added (OEF/OIF/ UNKNOWN OEF/OIF)
|
|---|
| 23 | ; SRC = 1 if HEC data (locked) or 0 if site entered
|
|---|
| 24 | ; If SRC is passed by reference, it must contain the values needed
|
|---|
| 25 | ; to 'stuff' a new record into the file at the fld # subscript level
|
|---|
| 26 | ; SRC(.02)=from dt SRC(.03)=to dt SRC(.04)=1 if HEC source of data
|
|---|
| 27 | ; SRC("OK") is returned as 1 if filing was successful or as the
|
|---|
| 28 | ; reason why the data was not filed if unsuccessful
|
|---|
| 29 | ;
|
|---|
| 30 | N DGFORCE,DIC,DA,DO,DD,X,Y,DIR,DIK,Z0
|
|---|
| 31 | S DGFORCE=$S($O(SRC("")):1,1:0)
|
|---|
| 32 | I DGFORCE,('$G(SRC(.01))!'$G(SRC(.02))!'$G(SRC(.03))) S SRC("OK")="MISSING DATA" Q
|
|---|
| 33 | S X=DGY,DIC("DR")=".05///NOW;.04////"_+$G(SRC)
|
|---|
| 34 | Q:'X
|
|---|
| 35 | I 'DGFORCE D
|
|---|
| 36 | . W !!,"Adding NEW "_DGCONF_" conflict data ...",!
|
|---|
| 37 | . S DIC("DR")=DIC("DR")_";.06////"_$S($G(DUZ(2)):DUZ(2),1:+$$SITE^VASITE())_";.02R;.03R"
|
|---|
| 38 | ;
|
|---|
| 39 | I DGFORCE D
|
|---|
| 40 | . S DIC("DR")=DIC("DR")_";.02///"_SRC(.02)_";.03///"_SRC(.03)
|
|---|
| 41 | ;
|
|---|
| 42 | S DIC(0)="L",DA(1)=DFN,DIC="^DPT("_DA(1)_",.3215," K DO,DD D FILE^DICN
|
|---|
| 43 | S Z0=$G(^DPT(DFN,.3215,+Y,0))
|
|---|
| 44 | I Z0'="",'$P(Z0,U,2)!'$P(Z0,U,3) D Q
|
|---|
| 45 | . S DA=+Y,DA(1)=DFN,DIK="^DPT("_DA(1)_",.3215," D ^DIK
|
|---|
| 46 | . I DGFORCE S SRC("OK")="DATA NOT FILED - BAD DATA"
|
|---|
| 47 | . I 'DGFORCE S DIR("A",1)="BAD DATA ENCOUNTERED. NO NEW CONFLICT DATA FILED.",DIR("A")="PRESS RETURN TO CONTINUE: ",DIR(0)="EA" D ^DIR K DIR
|
|---|
| 48 | I DGFORCE,'$D(SRC("OK")) S SRC("OK")=1
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | CKDT(DGCONF,DGMSE,DGPOSS) ; Check dates for conflict in DGCONF(DGCONF)=
|
|---|
| 52 | ; fr date^to date are valid against military service episodes (DGMSE)
|
|---|
| 53 | ; for the patient and if no dates, if the MSE's would support that
|
|---|
| 54 | ; conflict being entered.
|
|---|
| 55 | ; Assume DFN exists
|
|---|
| 56 | ; FUNCTION returns
|
|---|
| 57 | ; DGCONF(DGCONF,1)=1 if MSE inconsistency found,0 if none
|
|---|
| 58 | ; Also returns DGPOSS(DGCONF) if patient has no dates for the
|
|---|
| 59 | ; conflict, but the MSE's indicate entry of the conflict would
|
|---|
| 60 | ; not be inconsistent.
|
|---|
| 61 | ;
|
|---|
| 62 | N Z,CRNG,DGOK,FAIL
|
|---|
| 63 | S CRNG=$$GETCNFDT^DGRPDT(DGCONF)
|
|---|
| 64 | I $TR($G(DGCONF(DGCONF)),U)="" D Q ; Conflict pd not prev entered
|
|---|
| 65 | . S:$S(DGCONF="OEF"!(DGCONF="OIF")!(DGCONF="UNK"):0,1:1) DGCONF(DGCONF)=""
|
|---|
| 66 | . ; Check if conflict period COULD be valid based on MSE
|
|---|
| 67 | . S Z=0 F S Z=$O(DGMSE(Z)) Q:'Z D Q:$D(DGPOSS(DGCONF))
|
|---|
| 68 | .. I $S($P(DGMSE(Z),U)>$P(CRNG,U,2):1,$P(DGMSE(Z),U,2)<$P(CRNG,U):1,1:0) Q ; Not within valid for the mil svc pd for pt
|
|---|
| 69 | .. S DGPOSS(DGCONF)=""
|
|---|
| 70 | . ;
|
|---|
| 71 | S DGOK=1
|
|---|
| 72 | I $O(DGMSE(""))="" S DGOK=0,FAIL=1
|
|---|
| 73 | I DGOK F Z=0,1 I '$$VALCON^DGRPMS(DFN,DGCONF,$S($P(DGCONF(DGCONF),U,Z+1):$P(DGCONF(DGCONF),U,Z+1),1:DT),Z,.FAIL) S DGOK=0 Q
|
|---|
| 74 | S DGCONF(DGCONF,1)=$S(DGOK:"",$G(FAIL):1,1:0) ; MSE Inconsistency flag
|
|---|
| 75 | ;
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | NOCHG ;Only from,to dates can be chged on locally entered OEF/OIF conflict data
|
|---|
| 79 | N DIR,X,Y
|
|---|
| 80 | S DIR("A",1)="You may not change this field - but you may delete it",DIR("A")="Press RETURN to continue ",DIR(0)="EA" W ! D ^DIR K DIR W !
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | HELP(SET) ;Help text for reader prompt for conflict to add/edit/delete
|
|---|
| 84 | N Z,Z0
|
|---|
| 85 | W !!,"Those conflicts with a number enclosed in brackets ""[]"" are valid",!,"for the veteran while those enclosed in arrows ""<>"" are not.",!
|
|---|
| 86 | W !,$J("",5),"Select one of the following:",!
|
|---|
| 87 | F Z=1:1:$L(SET,";") S Z0=$P(SET,";",Z) I Z0'="" W !,$J("",15),$E($P(Z0,":")_$J("",10),1,10)_$P(Z0,":",2)
|
|---|
| 88 | W !
|
|---|
| 89 | N DIR,X,Y
|
|---|
| 90 | S DIR(0)="EA",DIR("A")="PRESS RETURN TO CONTINUE: " D ^DIR
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | LOOPCNF(DGCONF,DGPOSS,DIR) ; Loop thru non-OEF/OIF conflicts
|
|---|
| 94 | ; DGCONF,DGPOSS = arrays from DGRP6CL containing conflict data
|
|---|
| 95 | ; Returns DIR array for screen display of conflicts
|
|---|
| 96 | N LOOP,DGX,DGX1
|
|---|
| 97 | S DGX="VIET;4;Vietnam^LEB;5;Lebanon^GREN;6;Grenada^PAN;7;Panama^GULF;8;Gulf War^SOM;9;Somalia^YUG;10;Yugoslavia"
|
|---|
| 98 | F LOOP=1:1 Q:$P(DGX,U,LOOP)="" S DGX1=$P(DGX,U,LOOP) D
|
|---|
| 99 | . S DGCONF=$P(DGX1,";"),DG=$$ISVALID^DGRP6CL2(.DGCONF,.DGPOSS) I $G(DGCONF(DGCONF,"VEDIT")) S DIR(0)=DIR(0)_$P(DGX1,";",2)_":"_$P(DGX1,";",3)_";"
|
|---|
| 100 | . S DGCT=DGCT+1,DIR("A",DGCT)=$S($G(DGCONF(DGCONF,1)):"***",1:" ")_$E(DG,1)_$P(DGX1,";",2)_$E(DG,2)_$S($L($P(DGX1,";",2))<2:" ",1:"")_" -"_$J("",11-$L($P(DGX1,";",3)))_$P(DGX1,";",3)_": "
|
|---|
| 101 | . I $P(DGX1,";",2)=4 S DIR("A",DGCT)=DIR("A",DGCT)_$$YN^DGRP6CL(DG321,1)_$J("",6)_$E($$DAT^DGRP6CL(DG321,4,13)_$J("",12),1,12)_$E($$DAT^DGRP6CL(DG321,5,11)_$J("",12),1,12)
|
|---|
| 102 | . I $P(DGX1,";",2)=5 S DIR("A",DGCT)=DIR("A",DGCT)_$$YN^DGRP6CL(DG322,1)_$J("",6)_$E($$DAT^DGRP6CL(DG322,2,13)_$J("",12),1,12)_$E($$DAT^DGRP6CL(DG322,3,11)_$J("",12),1,12)
|
|---|
| 103 | . I $P(DGX1,";",2)=6 S DIR("A",DGCT)=DIR("A",DGCT)_$$YN^DGRP6CL(DG322,4)_$J("",6)_$E($$DAT^DGRP6CL(DG322,5,13)_$J("",12),1,12)_$E($$DAT^DGRP6CL(DG322,6,11)_$J("",12),1,12)
|
|---|
| 104 | . I $P(DGX1,";",2)=7 S DIR("A",DGCT)=DIR("A",DGCT)_$$YN^DGRP6CL(DG322,7)_$J("",6)_$E($$DAT^DGRP6CL(DG322,8,13)_$J("",12),1,12)_$E($$DAT^DGRP6CL(DG322,9,11)_$J("",12),1,12)
|
|---|
| 105 | . I $P(DGX1,";",2)=8 S DIR("A",DGCT)=DIR("A",DGCT)_$$YN^DGRP6CL(DG322,10)_$J("",6)_$E($$DAT^DGRP6CL(DG322,11,13)_$J("",12),1,12)_$E($$DAT^DGRP6CL(DG322,12,11)_$J("",12),1,12)
|
|---|
| 106 | . I $P(DGX1,";",2)=9 S DIR("A",DGCT)=DIR("A",DGCT)_$$YN^DGRP6CL(DG322,16)_$J("",6)_$E($$DAT^DGRP6CL(DG322,17,13)_$J("",12),1,12)_$E($$DAT^DGRP6CL(DG322,18,11)_$J("",12),1,12)
|
|---|
| 107 | . I $P(DGX1,";",2)=10 S DIR("A",DGCT)=DIR("A",DGCT)_$$YN^DGRP6CL(DG322,19)_$J("",6)_$E($$DAT^DGRP6CL(DG322,20,13)_$J("",12),1,12)_$E($$DAT^DGRP6CL(DG322,21,11)_$J("",12),1,12)
|
|---|
| 108 | ;
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
