| [613] | 1 | XUA4A72 ;SFISC/RWF - Person class API's ;08/05/2004 15:53
|
|---|
| 2 | ;;8.0;KERNEL;**27,49,74,132,222,300,327,357**;Jul 10, 1995;Build 2
|
|---|
| 3 | ; Entry Points (DBIA 1625)
|
|---|
| 4 | ; $$GET - Returns active class, given duz and date.
|
|---|
| 5 | ; $$IEN2CODE - Returns VA CODE from PERSON CLASS file, given IEN.
|
|---|
| 6 | ; $$CODE2TXT - Returns HCFA text from PERSON CLASS file, given IEN
|
|---|
| 7 | ; or VA CODE.
|
|---|
| 8 | Q ;No access from top.
|
|---|
| 9 | GET(IEN,DATE) ;sr. Get the active class on a date
|
|---|
| 10 | ;IEN of user.
|
|---|
| 11 | N X1,Y1,D
|
|---|
| 12 | S:$G(DATE)="" DATE=DT S D=DATE
|
|---|
| 13 | ;The return is file 200 ien_^_NODE
|
|---|
| 14 | S X1=$$GETUE(IEN,DATE) I X1'>0 Q X1
|
|---|
| 15 | S X1=$P(X1,"^",2,99) ;or X1=^VA(200,IEN,"USC1",+X1,0)
|
|---|
| 16 | S Y1=$G(^USC(8932.1,+X1,0))
|
|---|
| 17 | ;IEN^Occupation^specialty^sub-specialty^Effective date^expiration date^VA Code^specialty code
|
|---|
| 18 | Q +X1_U_$P(Y1,U,1,3)_U_$P(X1,U,2,3)_U_$P(Y1,U,6)_U_$P(Y1,U,9)
|
|---|
| 19 | ;
|
|---|
| 20 | IEN2CODE(IEN) ;sr. Get the code for an IEN
|
|---|
| 21 | Q $P($G(^USC(8932.1,+$G(IEN),0)),U,6)
|
|---|
| 22 | ;
|
|---|
| 23 | IEN2DATA(IEN) ;Get person class data for an IEN
|
|---|
| 24 | Q $G(^USC(8932.1,+$G(IEN),0))
|
|---|
| 25 | ;
|
|---|
| 26 | CODE2TXT(CODE) ;sr. Convert IEN or V-code to text
|
|---|
| 27 | I CODE?1"V"1.N S CODE=$$VCLK(CODE)
|
|---|
| 28 | Q $P($G(^USC(8932.1,+CODE,0)),U,1,3)
|
|---|
| 29 | ;
|
|---|
| 30 | VCLK(X) ;Lookup a V-code, Return IEN
|
|---|
| 31 | Q $O(^USC(8932.1,"F",X,0))
|
|---|
| 32 | ;
|
|---|
| 33 | GETUE(IEN,DATE) ;private, Get the user entry
|
|---|
| 34 | N D,X,Y,XUOK
|
|---|
| 35 | Q:'$D(^VA(200,+$G(IEN),0)) -1
|
|---|
| 36 | Q:$O(^VA(200,IEN,"USC1",0))="" -1
|
|---|
| 37 | S XUOK=0
|
|---|
| 38 | S D=$O(^VA(200,IEN,"USC1","AD",DATE))
|
|---|
| 39 | F S D=$O(^VA(200,IEN,"USC1","AD",D),-1) Q:D="" D Q:XUOK
|
|---|
| 40 | . S Y=""
|
|---|
| 41 | . F S Y=$O(^VA(200,IEN,"USC1","AD",D,Y),-1) Q:'Y D Q:XUOK
|
|---|
| 42 | . . S X=$G(^VA(200,IEN,"USC1",Y,0))
|
|---|
| 43 | . . I $P(X,U,2),DATE'<$P(X,U,2),DATE'>$P(X,U,3)!($P(X,U,3)="") S XUOK=1
|
|---|
| 44 | Q $S(XUOK:Y_U_X_U_U,1:-2)
|
|---|
| 45 | ;
|
|---|
| 46 | REMOVE ;Allow privileged user to remove a wrong entry in the users file.
|
|---|
| 47 | N XUDA,XUDA1,XUWT,%
|
|---|
| 48 | S XUDA1=+$$LOOKUP^XUSER Q:XUDA1'>0
|
|---|
| 49 | W !,"This user has the following Person Class enties:"
|
|---|
| 50 | S XUWT=^DD(8932.1,0,"ID","WRITE")
|
|---|
| 51 | F XUDA=0:0 S XUDA=$O(^VA(200,XUDA1,"USC1",XUDA)) Q:XUDA'>0 S %=+$G(^(XUDA,0)) I %>0 W !,$P(^USC(8932.1,%,0),U) X XUWT
|
|---|
| 52 | S DIR(0)="Y",DIR("A")="Are you sure you want to remove ALL these entries" D ^DIR Q:$D(DIRUT)!(Y'=1)
|
|---|
| 53 | F XUDA=0:0 S XUDA=$O(^VA(200,XUDA1,"USC1",XUDA)) Q:XUDA'>0 S DIK="^VA(200,DA(1),""USC1"",",DA=XUDA,DA(1)=XUDA1 D ^DIK
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | TERM(IEN,DATE) ;Called from XUSTERM, Set the expiration date for a user being terminated.
|
|---|
| 57 | N Y1
|
|---|
| 58 | Q:$G(DATE)'>0
|
|---|
| 59 | S Y1=$$GETUE(IEN,DATE)
|
|---|
| 60 | I Y1'>0!$L($P(Y1,"^",4)) Q
|
|---|
| 61 | D OLD(IEN,+Y1,DATE)
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | SET01 ;Called from the X-ref on the .01 field
|
|---|
| 65 | Q:$P(^VA(200,DA(1),"USC1",DA,0),U,2)>0
|
|---|
| 66 | S $P(^VA(200,DA(1),"USC1",DA,0),U,2)=DT ;Trigger date
|
|---|
| 67 | D UPDATE(200.05,2,DT)
|
|---|
| 68 | ;
|
|---|
| 69 | SET2 ;Call from the X-ref on the Effective Date field
|
|---|
| 70 | N L,REC
|
|---|
| 71 | S L=$O(^VA(200,DA(1),"USC1",DA),-1) Q:L'>0
|
|---|
| 72 | S REC=^VA(200,DA(1),"USC1",L,0)
|
|---|
| 73 | I $P(REC,U,3)="" D OLD(DA(1),L,$$MAX^XLFMTH(X,$P(REC,U,2))) ;Inactivate the old one
|
|---|
| 74 | Q
|
|---|
| 75 | KILL2 ;Call from the X-ref on the Effective Date field
|
|---|
| 76 | N L
|
|---|
| 77 | S L=$O(^VA(200,DA(1),"USC1",DA),-1) Q:L'>0
|
|---|
| 78 | I $P(^VA(200,DA(1),"USC1",L,0),U,3)=X D OLD(DA(1),L,"")
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | OLD(D0,D1,DATE) ;Inactivate the old one (Expiration Date)
|
|---|
| 82 | N DA,X
|
|---|
| 83 | S $P(^VA(200,D0,"USC1",D1,0),U,3)=DATE ;Inactivate the old one
|
|---|
| 84 | S DA(1)=D0,DA=D1 D UPDATE(200.05,3,DATE)
|
|---|
| 85 | Q
|
|---|
| 86 | UPDATE(DIH,DIG,DIV,DIU) ;file,field,new value,old value
|
|---|
| 87 | S DIV=$G(DIV),DIU=$G(DIU),DIV(0)=DA(1),DIV(1)=DA
|
|---|
| 88 | D ^DICR:$O(^DD(DIH,DIG,1,0))>0
|
|---|
| 89 | Q
|
|---|
| 90 | DDS1 ;Called from Pre-action person class field
|
|---|
| 91 | N %,XUDA,XU
|
|---|
| 92 | I X]"" S %=^USC(8932.1,X,0),XU(1)=$P(%,U,1),XU(2)=" "_$P(%,U,2),XU(3)=" "_$P(%,U,3) D HLP^DDSUTL(.XU)
|
|---|
| 93 | Q:DA'>0 M XUDA=DA N DA ;Hide DA
|
|---|
| 94 | S %=$$GET^DDSVAL(DIE,.XUDA,3,"","I"),%=$S(%>0:1,1:0)
|
|---|
| 95 | D UNED^DDSUTL(2,,,%),UNED^DDSUTL(3,,,%)
|
|---|
| 96 | Q
|
|---|
| 97 | DDS2 ;Called from effective date on form
|
|---|
| 98 | N %,XUDA M XUDA=DA N DA ;Hide DA
|
|---|
| 99 | S XUDA=$O(^VA(200,XUDA(1),"USC1",XUDA),-1) Q:XUDA'>0
|
|---|
| 100 | S %=$$GET^DDSVAL(DIE,.XUDA,3,"","I") Q:%&(%<X) ;Already has value
|
|---|
| 101 | D PUT^DDSVAL(DIE,.XUDA,3,X,"","I")
|
|---|
| 102 | Q
|
|---|
| 103 | DDS3(%) ;Data validation
|
|---|
| 104 | I %=2,$$GET^DDSVAL(DIE,.DA,3,"","I")]"" D
|
|---|
| 105 | . S DDSERROR=1
|
|---|
| 106 | . D HLP^DDSUTL("This field is uneditable because Expired Date already has data")
|
|---|
| 107 | . Q
|
|---|
| 108 | I %=3,DDSOLD]"",X'=DDSOLD D
|
|---|
| 109 | . S DDSERROR=1
|
|---|
| 110 | . D HLP^DDSUTL("You cannot change the value of this field.")
|
|---|
| 111 | . Q
|
|---|
| 112 | Q
|
|---|
