DGRPE ;ALB/MRL,LBD,BRM,TMK,BAJ - REGISTRATIONS EDITS ; 6/24/09 3:03pm
Source file <DGRPE.m>
Name | Comments | DBIA/ICR reference |
---|---|---|
605 | ;;.5291//NO;S:X'="Y" Y="@63";.5292:.5294;@63;
|
|
604 | ;;.525//NO;S:X'="Y" Y="@62";.526:.528;@62;
|
|
607 | ;;.368//NO;.369//NO;I $S('$D(^DPT(DA,.36)):1,$P(^(.36),U,8)="Y"!($P(^(.36),U,9)="Y"):0,1:1) S Y="@614";.37;@614;
|
|
606 | ;;I $P($G(^DPT(DFN,.361)),U,3)="H" S Y="@6131";.3602//NO;.3603//NO;S Y="@6132";@6131;.3602;.3603;@6132;
|
|
601 | ;;Q;
|
|
603 | ;;Q;
|
|
602 | ;;Q;
|
|
WARN32(X,DIPA,SEQ,Y) | ; Warn if the BOS is changed, then the component will
; be deleted ; Returns Y to skip component if the component should not be asked ; for this branch of service |
|
305000 | ;;S:$G(DGX1) Y="@38";.343;S:X']"" Y=.346;.344;S:X']"" Y=.346;.345:.347;.2202;.349;.34011;S DGX1=2;@38;
|
|
305001 | ;;S:$G(DGX1)=2 Y="@381";S DGX2=$G(^DPT(DA,.21));.341///^S X=$P(DGX2,U);.342///^S X=$P(DGX2,U,2);.343///^S X=$P(DGX2,U,3);.344///^S X=$P(DGX2,U,4);@381
|
|
305002 | ;;S:$G(DGX1)=2 Y="@39";.345///^S X=$P(DGX2,U,5);.346///^S X=$P(DGX2,U,6);.347///^S X=$P(DGX2,U,7);.348///^S X=$P(DGX2,U,8);.349///^S X=$P(DGX2,U,9);.34011///^S X=$P(DGX2,U,11);@39;K DGX1,DGX2;
|
|
111 | ;;.14105//NO;S:X="N" Y="@111" S:X="Y" DIE("NO^")="";.1417;I X']"" W !?4,$C(7),"But I need a Start Date." S Y=.14105;.1418;D DR111^DGRPE;.141;I '$P($$CAACT^DGRPCADD(DFN),U,2) W !?4,"But I need at least one active category." S Y=.14105;
|
|
303000 | ;;S:$G(DGX1) Y="@341";.333;S:X']"" Y=.336;.334;S:X']"" Y=.336;.335:.337;.2201;.339;.33011;S DGX1=2;@341;
|
|
112 | ;;.134;.135;.133
|
|
DR109 | ;Drop through (use same logic as DR203)
|
|
105000 | ;;N RET S RET=1 D EN^DGREGTED(DFN,"TEMP",.RET) S:'RET Y=.12105;@15;K DIE("NO^");
|
|
PRF | ; Write Proof needed for FV
|
|
DR111 | ;Set DR string for Confidential Address categories
|
|
302000 | ;;.2193;S:X']"" Y=.2196;.2194;S:X']"" Y=.2196;.2195:.2197;.2203;.2199;.211011;@32;
|
|
CMP(X) | ; Function to determine if service component is valid for
; branch of service ien in X 0 = invalid 1 = valid ; Component only valid for ARMY/AIR FORCE/MARINES/COAST GUARD/NOAA/USPHS |
|
303002 | ;;S:$G(DGX1)=2 Y="@351";.335///^S X=$P(DGX2,U,5);.336///^S X=$P(DGX2,U,6);.337///^S X=$P(DGX2,U,7);.338///^S X=$P(DGX2,U,8);.339///^S X=$P(DGX2,U,9);.33011///^S X=$P(DGX2,U,11);@351;K DGX1,DGX2;
|
|
SETFLDS(DGDR) | ; Set up fields to edit
|
|
303001 | ;;S:$G(DGX1)=2 Y="@35";S DGX2=$G(^DPT(DA,.21));.331///^S X=$P(DGX2,U);.332///^S X=$P(DGX2,U,2);.333////^S X=$P(DGX2,U,3);.334///^S X=$P(DGX2,U,4);@35;
|
|
DR203 | ||
402 | ;;.2514;.2515;S:($S(X']"":1,X=3:1,X=9:1,1:0)) Y="@42" S:(X'=5) Y=.251;.2516;.251;S:X']"" Y="@42";.252;S:X']"" Y=.255;.253;S:X']"" Y=.255;.254:.256;.2206;.258;@42;
|
|
401 | ;;.01;.31115;S:($S(X']"":1,X=3:1,X=9:1,1:0)) Y="@41" S:(X'=5) Y=.3111;.31116;.3111;S:X']"" Y="@41";.3113;S:X']"" Y=.3116;.3114;S:X']"" Y=.3116;.3115:.3117;.2205;.3119;@41;
|
|
111000 | ;;K DR(2,2.141);N RET S RET=1 D EN^DGREGTED(DFN,"CONF",.RET) S:'RET Y=.14105;@111;K DIE("NO^");
|
|
502 | ;;.381;.382///NOW;
|
|
302 | ;;.2191;S:X']"" Y="@32";.2192;D DR301^DGRPE S:DG4=1 Y=.2193;.21925//NO;I X="Y" S DGADD=".211" D AD^DGRPE S Y=.211011;
|
|
501 | ;;
|
|
201 | ;;.05;.08;.092;.093;.2401:.2403;57.4//NOT APPLICABLE;
|
|
203 | ;;D DR203^DGRPE;6ETHNICITY;2RACE;K DR(2,2.02),DR(2,2.06);
|
|
202 | ;;1010.15//NO;S:X'="Y" Y="@22";S DIE("NO^")="";1010.152;I X']"" W !?4,*7,"But I need to know where you were treated most recently." S Y=1010.15;1010.151;1010.154;S:X']"" Y="@22";1010.153;@22;K DIE("NO^");
|
|
205 | ;;.181;
|
|
AD | ||
301 | ;;.211;S:X']"" Y="@31";.212;D DR301^DGRPE S:DG4=1 Y=.213;.2125//NO;I X="Y" S DGADD=".21" D AD^DGRPE S Y=.21011;.213;K DG4;S:X']"" Y=.216;.214;S:X']"" Y=.216;.215:.217;.2207;.219;.21011;@31;
|
|
SETDR(DGDR,DR) | ; Set up DR string(s) for edit groups selected
|
|
303 | ;;N DGX1,DGX2;I '$L($P($G(^DPT(DFN,.21)),U)) S Y="@33";.3305//NO;I X="Y" S Y="@34",DGX1=1 S:$D(^DPT(DFN,.22)) $P(^(.22),U,1)=$P(^(.22),U,7);@33;.331;S:X']"" DGX1=2,Y="@34";.332;@34;
|
|
304 | ;;.3311;S:X']"" Y="@36";.3312;.3313;S:X']"" Y=.3316;.3314;S:X']"" Y=.3316;.3315:.3317;.2204;.3319;.331011;@36;
|
|
305 | ;;N DGX1,DGX2;I '$L($P($G(^DPT(DFN,.21)),U)) S Y="@37";.3405//NO;I X="Y" S DGX1=1,Y="@371" S:$D(^DPT(DFN,.22)) $P(^(.22),U,2)=$P(^(.22),U,7);@37;.341;S:X']"" DGX1=2,Y="@371";.342;@371;
|
|
608 | ;;S DGPHFLG=0;.531;S:X'="Y" DGX=X,Y="@616";.532///^S X="PENDING";S Y="@6161";@616;S:DGX'="N" Y="@6162";.533///^S X="VAMC";@6161;S DGPHFLG=1;.535///^S X=$$DIV^DGRPLE();@6162;
|
|
Q | ||
S | ||
109 | ;;N FLG S (FLG(1),FLG(2))=1 D EN^DGREGAED(DFN,.FLG);.02;D DR109^DGRPE;6;2;K DR(2,2.02),DR(2,2.06);.05;.08;K DIE("NO^");
|
|
102 | ;;1;
|
|
103 | ;;.091;
|
|
101 | ;;
|
|
104 | ;;N FLG S (FLG(1),FLG(2))=1 D EN^DGREGAED(DFN,.FLG);
|
|
105 | ;;.12105//NO;S:X="N" Y="@15" S:X="Y" DIE("NO^")="";.1217;I X']"" W !?4,$C(7),"But I need a Start Date for this Temporary Address." S Y=.12105;.1218;
|
|
503 | ;;.383;
|
|
SET32(DA,DIPA,SEQ) | ; Extract the .32 node from patient file and set DIPA
; array with the BOS and component data for the SEQ military service ; episode (1-3) |
|
DR301 | ;set up variables for foreign address
|
Name | Field # of Occurrence |
---|---|
$$CVEDT^DGCV | DGRPE+35 |
EDIT^DGRP15 | DGRPE+25 |
EN^DGRP61 | DGRPE+17 |
EN^DGRP6CL | DGRPE+22 |
EN^DGRP6EF | DGRPE+23 |
^DGRPE1 | DGRPE+29 |
^DGRPE4 | DGRPE+30 |
CEDITS^DGRPECE | DGRPE+7 |
^DGRPEIS | DGRPE+8 |
EDIT9^DGRPEIS2 | DGRPE+9 |
EDITPH1^DGRPLE | DGRPE+38 |
^DIE | DGRPE+33 |
^DIR | DGRPE+37 |
PREG^IBCNBME | DGRPE+11 |
REG^IBCNBME | DGRPE+12 |
Name | Line Occurrences |
---|---|
Function Call: WRITE |
|
Function Call: WRITE |
|
Function Call: WRITE |
|
Function Call: WRITE |
|
Function Call: WRITE |
|
Routine Call |
|
Routine Call |
|
FileNo | Call Tags |
---|---|
^DPT - [#2] | Classic Fileman Calls |
Name | Line Occurrences (* Changed, ! Killed) |
---|---|
^DPT - [#2] | AD+1, AD+2*, DR301+3, SET32+5 |
^HL(779.004 - [#779.004] | DR301+4 |
Name | Line Occurrences |
---|---|
$$CMP | WARN32+5 |
Q | DGRPE+8, DGRPE+9, DGRPE+15, DGRPE+25 |
S | SETDR+4, SETDR+6 |
SETDR | DGRPE+31 |
Name | Field # of Occurrence |
---|---|
^( | AD+1*, SET32+5 |
>> | Not killed explicitly |
* | Changed |
! | Killed |
~ | Newed |
Name | Field # of Occurrence |
---|---|
DA | DGRPE+28*, DGRPE+32*, Q!, AD+1, SET32~, SET32+5 |
>> DFN | DGRPE+7, DGRPE+11, DGRPE+12, DGRPE+17, DGRPE+22, DGRPE+23, DGRPE+28, DGRPE+32, DGRPE+35, AD+2 , DR301+3 |
DG3 | DR301+1~, DR301+3*, DR301+5 |
DG33 | DR301+1~, DR301+4*, DR301+5 |
>> DG4 | DR301+2*, DR301+5* |
DGADD | AD+1, AD+2, AD+3! |
DGCOMLOC | Q! |
DGCT | DGRPE+28*, Q!, SETDR+1~, SETDR+2*, S+1* |
DGCVFLG | DGRPE+35, Q! |
DGDR | DGRPE+7, DGRPE+10, DGRPE+15, DGRPE+17, DGRPE+22, DGRPE+23, DGRPE+31, Q!, SETDR~, SETDR+3 , SETFLDS~ |
DGDRD | Q!, SETDR+4*, SETDR+6*, S, S+1 |
DGDRS | DGRPE+28*, Q!, SETDR+1~, SETDR+2*, S, S+1* |
DGPC | AD~, AD+2* |
DGPH | DGRPE+27~ |
DGPHFLG | DGRPE+27~, DGRPE+38 |
DGPHONE | AD+1*, AD+3! |
>> DGPRFLG | DGRPE+11 |
DGRPADI | Q! |
>> DGRPS | DGRPE+7, DGRPE+8, DGRPE+9, DGRPE+10, DGRPE+15, DGRPE+25, DGRPE+29, DGRPE+30 |
DGZ4 | AD~, AD+1*, AD+2 |
DIE | DGRPE+28*, DGRPE+32*, Q! |
DIPA | Q!, SET32~, WARN32~ |
DIPA("X" | SET32+6* |
DIPA(32 | SET32+4!, SET32+6*, WARN32+6 |
>> DIQUIET | WARN32+9 |
DIR | DGRPE+37! |
DIR(0 | DGRPE+37* |
DR | DGRPE+28!*, DGRPE+31, Q!, SETDR~, SETDR+2!* |
DR(2 | DR203*, DR203+1*, DR111+1* |
I | Q!, SETDR+3*, SET32+3~ |
J | Q!, SETDR+3*, SETDR+6 |
J1 | Q!, SETDR+1~, SETDR+3*, SETDR+6* |
J2 | SETDR+1~, SETDR+5~, SETDR+6* |
Q | SET32+3~, SET32+5*, SET32+6 |
QUIT | DGRPE+14~*, DGRPE+15, DGRPE+22, DGRPE+23 |
SEQ | SET32~, SET32+4, SET32+6, WARN32~, WARN32+5, WARN32+6 |
U | DGRPE+35, AD+1, AD+2, DR301+3, SET32+6, WARN32+7 |
X | AD+1*, WARN32~, WARN32+5, WARN32+7, CMP~, CMP+3 |
Y | DGRPE+28*, DGRPE+32*, AD+1*, WARN32~, WARN32+5* |
Z | SET32+3~, SET32+5*, SET32+6, WARN32+4~, WARN32+6*, WARN32+7 |
Name | Field # of Occurrence |
---|---|
$T(@J1 | SETDR+3, SETDR+4, SETDR+6 |