DGRPP.m

DGRPP ;ALB/MRL,AEG,LBD - REGISTRATION SCREEN PROCESSOR ; 10/21/10 3:55pm

 ;;5.3;PIMS;**92,147,343,404,397,489,689,1015,1016**;JUN 30, 2012;Build 20

 ;

 ;DGRPS    : Screen to edit

 ;DGRPSEL  : If screen 9 (income screening) set to allowable selections

 ;           (V=Veteran, S=Spouse, D=Dependents)

 ;DGRPSELT : If screen 9, type selected (V, S, or D or all if none specified)

 ;DGRPAN   : Selectable items on screen for edit (user input)

 ;DGRPANP  : Selectable items for print on page footer - i.e. 1-3

 ;DGRPANN  : Selected item(s) extrapolated (screen_item)

 ;

 ;

EN ;

 D:'$$BEGUPLD^DGENUPL3(DFN)

 .D UNLOCK^DGENPTA1(DFN)

 .D CKUPLOAD^DGENUPL3(DFN)

 .I $$LOCK^DGENPTA1(DFN)

 D ENDUPLD^DGENUPL3(DFN)

 D Q1,WHICH^DGRPP1 W ! K DGRP S DGRPAN="" F I=1:1:$L(DGRPVV(DGRPS)) I $S('DGRPV:1,DGRPS=6:I=1!(I=2)!(I=3),1:0) S:'$E(DGRPVV(DGRPS),I) DGRPAN=DGRPAN_I_","

 D STR^DGRPP1 F I=$Y:1:20 W !

 ; remove COPY option DG*5.3*688

 I ("8^9"[DGRPS),($G(DGEFDT)'=DT) S Z="E" D W W "=ENTER new "_(DGISYR+1)_" data,"

 S Z="<RET>" D W W " to ",$S(DGRPS<DGRPLAST:"CONTINUE",1:"QUIT"),", "

 I DGRPAN]"" S Z=DGRPANP D W D

 . I '$G(DGRPV) W " or " S Z="ALL" D W

 . W " to "_$S('$G(DGRPV):"EDIT, ",DGRPS=6:"EXPAND, ",1:"")

 S DGRPOUT=0,Z="^N" D W W " for screen N or " S Z="'^'" D W W " to QUIT" I DGRPSEL=""!(DGRPVV(9)'["0")!+$G(DGRPV) W ": "

 I DGRPSEL]"" D MOREHLP^DGRPP1

 G:$E(IOST,1,2)="P-" NEXT  ;RGB/VM 4/28/10 Just go to next screen for non-interactive jobs

 R DGRPANN:DTIME S:'$T DGRPOUT=1 I DGRPANN']"",'DGRPOUT G NEXT

 I $E(DGRPANN)="E",$G(DGNOBUCK),("8^9"[DGRPS) D

 .S DGNOCOPY=1

 . ; remove COPY option DG*5.3*688

 .S DGRPANN=U_DGRPS,DGRPVV(9)="000",DGRPVV(8)="00",DGIAINEW=1

JUMP G JUMP^DGRPP1:DGRPANN?1"^"1N.".".1N I DGRPOUT!(DGRPANN?1"^".E) G Q

 S (DGRPANN,X)=$$UPPER^DGUTL(DGRPANN)

 I $E(DGRPANN)="A" S X=DGRPANN,Z="^ALL" D IN^DGHELP I %'=-1 S DGRPANN=DGRPANP

 I DGRPANN]"",(DGRPSEL[$E(DGRPANN)) S DGRPSELT=$E(DGRPANN),DGRPANN=$P(DGRPANN,DGRPSELT,2) ; save off type, run through all other checks

 I DGRPANN'?1N.E D ^DGRPH G:DGRPS'=1.1 @("^DGRP"_DGRPS) G:DGRPS=1.1 ^DGRPCADD

 S DGDR="" F I=1:1 S DGCH=$P(DGRPANN,",",I) Q:DGCH']""!($L(DGCH)>5)  D CHOICE

 I DGDR']"" D ^DGRPH S X=DGRPS G SCRX

 D ^DGRPE G QQ:'$D(^DPT(DFN,0)) S X=DGRPS G SCRX

Q I 'DGELVER D:$S(DGRPOUT:0,'$D(DGRPV):0,'DGRPV:1,1:0) LT^DGRPP1

 K DGDEP,DGINC,DGINR,DGMTC,DGMTED,DGREL,DGTOT,DGSP

 K DGCH,DGGTOT,DGIRI,DGPRI,DGRPSE1,DGNOCOPY

 D SENSCHK

 I 'DGRPV S DGEDCN=1 D ^DGRPC K DGEDCN

QQ K DGRPNA,DGRPS,DGRPTYPE,DGRPU,DGRPV,DGRPVV,DGRPW,DGVI,DGVO,DGRPCM,DGELVER,DGRPLAST

Q1 K %DT,C,DGA,DGA1,DGA2,DGAD,DGDR,DGRP,DGRPAG,DGRPAN,DGRPANN,DGRPANP,DGRPD,DGRPSEL,DGRPSELT,DGRPVR,DGRPX,DGAAC

 K DIRUT,DUOUT,DTOUT

 K DIC,I,I1,I2,I3,J,X,X1,X2,X3,Y,Z,Z1 I $D(DFN)#2,DFN]"" S:$D(^DPT(DFN,0)) DA=DFN

 Q

 ;

SENSCHK ; check whether patient record should be made sensitive

 N ELIG,FLAG,X

 S ELIG=0,FLAG=0

 I '$D(^DPT($G(DFN),0)) Q  ; patient not defined

 I $D(^DGSL(38.1,DFN,0)) Q  ; patient already in dg security log file

 S X=$S($D(^DPT(DFN,"TYPE")):+^("TYPE"),1:"") I $D(^DG(391,+X,0)),$P(^(0),"^",4) D SEC Q:FLAG

 F  S ELIG=$O(^DPT(DFN,"E",ELIG)) Q:'ELIG  D  Q:FLAG

 . S X=$G(^DIC(8,ELIG,0))

 . I $P(X,"^",12) D SEC

 Q

 ;

SEC ;if patient type says make record sensitive, add to security log file

 K DD,DO S DIC="^DGSL(38.1,",(X,DINUM)=DFN,DIC(0)="L",DIC("DR")="2///1;3////"_DUZ_";4///NOW;" D FILE^DICN

 I $D(^DGSL(38.1,DFN,0)) W !!,"===> Record has been classified as sensitive." S FLAG=1

 K DIC,X,DINUM,DA,DD,DO,Y

 Q

 ;

CHOICE ;parse out which items were selected for edit

 ;

 ;DGCH=choice to be parsed (either number or number-number)

 ;

 N DGFL S DGFL=0

 I DGCH["-" Q:DGCH'?1.2N1"-"1.2N!($P(DGCH,"-",2)>17)  F J=$P(DGCH,"-",1):1:$P(DGCH,"-",2) I DGRPAN[(J_",") D:(DGRPS=9) SCR9 I 'DGFL S DGDR=DGDR_(DGRPS*100+J)_","

 I DGCH'["-",DGCH?1.2N,(DGRPAN[(DGCH_",")) S DGDR=DGDR_(DGRPS*100+DGCH)_","

 Q

 ;

NEXT ;find next available screen...goto

 I DGRPS=DGRPLAST G Q ;last screen and return...quit

 S X=DGRPLAST

 F I=DGRPS+1:1 S J=$E(DGRPVV,I) Q:J']""  I 'J S X=I Q

 I DGRPS=1 S X=1.1

SCRX ;goto screen X

 ;I DGRPLAST=DGRPS,DGRPLAST=X G Q

 I X[".",X'=1.1 S X=$P(X,".",1)

 G:X=1.1 ^DGRPCADD

 G:X'=1.1 @("^DGRP"_X) ;goto next available screen

 ;

W ;write highlighted text on screen (if parameter on)

 I IOST="C-QUME",$L(DGVI)'=2 W Z

 E  W @DGVI,Z,@DGVO

 Q

 ;

SCR9 ; see if MT is completed.  Allow only selective editing if so

 I 'DGMTC Q

 I '$D(DGRPSELT) S:DGMTC=1 DGFL=1 Q  ;if no non-mt dependents

 I DGRPSELT="S",$D(DGMTC("S")) Q

 I DGRPSELT="D",$D(DGMTC("D")) Q

 S DGFL=1

 Q

DGRPP     ;ALB/MRL,AEG,LBD - REGISTRATION SCREEN PROCESSOR ; 10/21/10 3:55pm

 +1       ;;5.3;PIMS;**92,147,343,404,397,489,689,1015,1016**;JUN 30, 2012;Build 20

 +2       ;

 +3       ;DGRPS    : Screen to edit

 +4       ;DGRPSEL  : If screen 9 (income screening) set to allowable selections

 +5       ;           (V=Veteran, S=Spouse, D=Dependents)

 +6       ;DGRPSELT : If screen 9, type selected (V, S, or D or all if none specified)

 +7       ;DGRPAN   : Selectable items on screen for edit (user input)

 +8       ;DGRPANP  : Selectable items for print on page footer - i.e. 1-3

 +9       ;DGRPANN  : Selected item(s) extrapolated (screen_item)

 +10      ;

 +11      ;

EN        ;

 +1        IF '$$BEGUPLD^DGENUPL3(DFN)

               Begin DoDot:1

 +2                DO UNLOCK^DGENPTA1(DFN)

 +3                DO CKUPLOAD^DGENUPL3(DFN)

 +4                IF $$LOCK^DGENPTA1(DFN)

               End DoDot:1

 +5        DO ENDUPLD^DGENUPL3(DFN)

 +6        DO Q1

           DO WHICH^DGRPP1

           WRITE !

           KILL DGRP

           SET DGRPAN=""

           FOR I=1:1:$LENGTH(DGRPVV(DGRPS))

               IF $SELECT('DGRPV:1,DGRPS=6:I=1!(I=2)!(I=3),1:0)

                   IF '$EXTRACT(DGRPVV(DGRPS),I)

                       SET DGRPAN=DGRPAN_I_","

 +7        DO STR^DGRPP1

           FOR I=$Y:1:20

               WRITE !

 +8       ; remove COPY option DG*5.3*688

 +9        IF ("8^9"[DGRPS)

               IF ($GET(DGEFDT)'=DT)

                   SET Z="E"

                   DO W

                   WRITE "=ENTER new "_(DGISYR+1)_" data,"

 +10       SET Z="<RET>"

           DO W

           WRITE " to ",$SELECT(DGRPS<DGRPLAST:"CONTINUE",1:"QUIT"),", "

 +11       IF DGRPAN]""

               SET Z=DGRPANP

               DO W

               Begin DoDot:1

 +12               IF '$GET(DGRPV)

                       WRITE " or "

                       SET Z="ALL"

                       DO W

 +13               WRITE " to "_$SELECT('$GET(DGRPV):"EDIT, ",DGRPS=6:"EXPAND, ",1:"")

               End DoDot:1

 +14       SET DGRPOUT=0

           SET Z="^N"

           DO W

           WRITE " for screen N or "

           SET Z="'^'"

           DO W

           WRITE " to QUIT"

           IF DGRPSEL=""!(DGRPVV(9)'["0")!+$GET(DGRPV)

               WRITE ": "

 +15       IF DGRPSEL]""

               DO MOREHLP^DGRPP1

 +16      ;RGB/VM 4/28/10 Just go to next screen for non-interactive jobs

           IF $EXTRACT(IOST,1,2)="P-"

               GOTO NEXT

 +17       READ DGRPANN:DTIME

           IF '$TEST

               SET DGRPOUT=1

           IF DGRPANN']""

               IF 'DGRPOUT

                   GOTO NEXT

 +18       IF $EXTRACT(DGRPANN)="E"

               IF $GET(DGNOBUCK)

                   IF ("8^9"[DGRPS)

                       Begin DoDot:1

 +19                       SET DGNOCOPY=1

 +20      ; remove COPY option DG*5.3*688

 +21                       SET DGRPANN=U_DGRPS

                           SET DGRPVV(9)="000"

                           SET DGRPVV(8)="00"

                           SET DGIAINEW=1

                       End DoDot:1

JUMP       IF DGRPANN?1"^"1N.".".1N

               GOTO JUMP^DGRPP1

           IF DGRPOUT!(DGRPANN?1"^".E)

               GOTO Q

 +1        SET (DGRPANN,X)=$$UPPER^DGUTL(DGRPANN)

 +2        IF $EXTRACT(DGRPANN)="A"

               SET X=DGRPANN

               SET Z="^ALL"

               DO IN^DGHELP

               IF %'=-1

                   SET DGRPANN=DGRPANP

 +3       ; save off type, run through all other checks

           IF DGRPANN]""

               IF (DGRPSEL[$EXTRACT(DGRPANN))

                   SET DGRPSELT=$EXTRACT(DGRPANN)

                   SET DGRPANN=$PIECE(DGRPANN,DGRPSELT,2)

 +4        IF DGRPANN'?1N.E

               DO ^DGRPH

               IF DGRPS'=1.1

                   GOTO @("^DGRP"_DGRPS)

               IF DGRPS=1.1

                   GOTO ^DGRPCADD

 +5        SET DGDR=""

           FOR I=1:1

               SET DGCH=$PIECE(DGRPANN,",",I)

               IF DGCH']""!($LENGTH(DGCH)>5)

                   QUIT 

               DO CHOICE

 +6        IF DGDR']""

               DO ^DGRPH

               SET X=DGRPS

               GOTO SCRX

 +7        DO ^DGRPE

           IF '$DATA(^DPT(DFN,0))

               GOTO QQ

           SET X=DGRPS

           GOTO SCRX

Q          IF 'DGELVER

               IF $SELECT(DGRPOUT

                   DO LT^DGRPP1

 +1        KILL DGDEP,DGINC,DGINR,DGMTC,DGMTED,DGREL,DGTOT,DGSP

 +2        KILL DGCH,DGGTOT,DGIRI,DGPRI,DGRPSE1,DGNOCOPY

 +3        DO SENSCHK

 +4        IF 'DGRPV

               SET DGEDCN=1

               DO ^DGRPC

               KILL DGEDCN

QQ         KILL DGRPNA,DGRPS,DGRPTYPE,DGRPU,DGRPV,DGRPVV,DGRPW,DGVI,DGVO,DGRPCM,DGELVER,DGRPLAST

Q1         KILL %DT,C,DGA,DGA1,DGA2,DGAD,DGDR,DGRP,DGRPAG,DGRPAN,DGRPANN,DGRPANP,DGRPD,DGRPSEL,DGRPSELT,DGRPVR,DGRPX,DGAAC

 +1        KILL DIRUT,DUOUT,DTOUT

 +2        KILL DIC,I,I1,I2,I3,J,X,X1,X2,X3,Y,Z,Z1

           IF $DATA(DFN)#2

               IF DFN]""

                   IF $DATA(^DPT(DFN,0))

                       SET DA=DFN

 +3        QUIT 

 +4       ;

SENSCHK   ; check whether patient record should be made sensitive

 +1        NEW ELIG,FLAG,X

 +2        SET ELIG=0

           SET FLAG=0

 +3       ; patient not defined

           IF '$DATA(^DPT($GET(DFN),0))

               QUIT 

 +4       ; patient already in dg security log file

           IF $DATA(^DGSL(38.1,DFN,0))

               QUIT 

 +5        SET X=$SELECT($DATA(^DPT(DFN,"TYPE")):+^("TYPE"),1:"")

           IF $DATA(^DG(391,+X,0))

               IF $PIECE(^(0),"^",4)

                   DO SEC

                   IF FLAG

                       QUIT 

 +6        FOR 

               SET ELIG=$ORDER(^DPT(DFN,"E",ELIG))

               IF 'ELIG

                   QUIT 

               Begin DoDot:1

 +7                SET X=$GET(^DIC(8,ELIG,0))

 +8                IF $PIECE(X,"^",12)

                       DO SEC

               End DoDot:1

               IF FLAG

                   QUIT 

 +9        QUIT 

 +10      ;

SEC       ;if patient type says make record sensitive, add to security log file

 +1        KILL DD,DO

           SET DIC="^DGSL(38.1,"

           SET (X,DINUM)=DFN

           SET DIC(0)="L"

           SET DIC("DR")="2///1;3////"_DUZ_";4///NOW;"

           DO FILE^DICN

 +2        IF $DATA(^DGSL(38.1,DFN,0))

               WRITE !!,"===> Record has been classified as sensitive."

               SET FLAG=1

 +3        KILL DIC,X,DINUM,DA,DD,DO,Y

 +4        QUIT 

 +5       ;

CHOICE    ;parse out which items were selected for edit

 +1       ;

 +2       ;DGCH=choice to be parsed (either number or number-number)

 +3       ;

 +4        NEW DGFL

           SET DGFL=0

 +5        IF DGCH["-"

               IF DGCH'?1.2N1"-"1.2N!($PIECE(DGCH,"-",2)>17)

                   QUIT 

               FOR J=$PIECE(DGCH,"-",1):1:$PIECE(DGCH,"-",2)

                   IF DGRPAN[(J_",")

                       IF (DGRPS=9)

                           DO SCR9

                       IF 'DGFL

                           SET DGDR=DGDR_(DGRPS*100+J)_","

 +6        IF DGCH'["-"

               IF DGCH?1.2N

                   IF (DGRPAN[(DGCH_","))

                       SET DGDR=DGDR_(DGRPS*100+DGCH)_","

 +7        QUIT 

 +8       ;

NEXT      ;find next available screen...goto

 +1       ;last screen and return...quit

           IF DGRPS=DGRPLAST

               GOTO Q

 +2        SET X=DGRPLAST

 +3        FOR I=DGRPS+1:1

               SET J=$EXTRACT(DGRPVV,I)

               IF J']""

                   QUIT 

               IF 'J

                   SET X=I

                   QUIT 

 +4        IF DGRPS=1

               SET X=1.1

SCRX      ;goto screen X

 +1       ;I DGRPLAST=DGRPS,DGRPLAST=X G Q

 +2        IF X["."

               IF X'=1.1

                   SET X=$PIECE(X,".",1)

 +3        IF X=1.1

               GOTO ^DGRPCADD

 +4       ;goto next available screen

           IF X'=1.1

               GOTO @("^DGRP"_X)

 +5       ;

W         ;write highlighted text on screen (if parameter on)

 +1        IF IOST="C-QUME"

               IF $LENGTH(DGVI)'=2

                   WRITE Z

 +2       IF '$TEST

               WRITE @DGVI,Z,@DGVO

 +3        QUIT 

 +4       ;

SCR9      ; see if MT is completed.  Allow only selective editing if so

 +1        IF 'DGMTC

               QUIT 

 +2       ;if no non-mt dependents

           IF '$DATA(DGRPSELT)

               IF DGMTC=1

                   SET DGFL=1

               QUIT 

 +3        IF DGRPSELT="S"

               IF $DATA(DGMTC("S"))

                   QUIT 

 +4        IF DGRPSELT="D"

               IF $DATA(DGMTC("D"))

                   QUIT 

 +5        SET DGFL=1

 +6        QUIT