AGEDPRV1.m

AGEDPRV1 ;IHS/ASDS/TPF - EDIT/DISPLAY PRIVATE INSURANCE PAGE A OVERFLOW CODE ;    

 ;;7.1;PATIENT REGISTRATION;**1,2,3**;APR 3, 2007

 ;

 Q

 ;CALLED FROM AGEDPRV

NOTREG(POLHPTR) ;EP - IS THIS POLICY HOLDER REGISTERED?

 I '$G(POLHPTR) W !,"NO POLICY HOLDER!" Q

 N PATPTR

 S PATPTR=$P($G(^AUPN3PPH(POLHPTR,0)),U,2)

 I $G(PATPTR)'="",'$D(^DPT(PATPTR,0)) W " [NOT REG]"

 I PATPTR="" W " [NOT REG]"

 Q

 ;CALLED FROM AGEDPRV

DISPHLP(ID0,FIELD) ;EP -

 W !!,"DATA COULD NOT BE TRANSFERRED TO THE POLICY HOLDER FILE!"

 W !!,"DATA IMPROPERLY FORMATTED"

 Q

 ;CALLED FROM AGEDPRV

CONFIRM ;EP -

 K DIR

 S DIR(0)="Y"

 S DIR("A")="Do you wish to add "_$G(TARGET)_" as the Insured Policy Holder"

 D ^DIR

 I 'Y K POLHPTR,NEWPTR S EXIT=1 Q

 ;I 'Y D CLEAN11(ID0,ID1) K POLHPTR,NEWPTR S EXIT=1 Q  ;AG*7.1*3 IM23566

 Q:$G(REGISTER)

 D ADDPOLH^AGEDPRVP(ID0,ID1,$G(TARGET),.POLHPTR,REGISTER,SAME)

 Q

 ;CALLED FROM AGEDPRV

PUTPOLH(NEWPH,PATPTR,POLHPTR,TYPE,FIELD,SAME,EXIT,INSPTR) ;EP -

 ;IF NEW POL HOLD. STUFF PT INTO NEW PH ENTRY

 I TYPE="NEW" D

 .K DIC,DIE,DA,DIR,DO,DD,DINUM,X,DR

 .S FILE=""

 .F  S FILE=$O(FIELD(FILE)) Q:FILE=""  D  Q:$G(EXIT)

 ..S FLD=""

 ..F  S FLD=$O(FIELD(FILE,FLD)) Q:FLD=""  D

 ...I FILE=2 S NFLD=$S(FLD=.01:.01,FLD=.111:.09,FLD=.114:.11,FLD=.115:.12,FLD=.116:.13,FLD=.131:.14,FLD=.02:.08,FLD=.03:.19,FLD=.21:.15,1:99999)

 ...I FILE=9000001 S NFLD=$S(FLD=.19:.16,FLD=.21:.15,1:9999999)

 ...I FIELD(FILE,FLD)'="" S X=FIELD(FILE,FLD) X $P(^DD(9000003.1,NFLD,0),U,5,999) I '$D(X) W !,"PROBLEM WITH FIELD ",NFLD," IN FILE ",FILE," THE DATA IS ",FIELD(FILE,FLD) Q  ;Q:'$D(X)

 ...;W !,"FIELD "_NFLD_" IN FILE "_FILE_" PASSES INPUT TRANSFORM: "_FIELD(FILE,FLD)

 ...;I NFLD=".19" S DIC("DR")=$G(DIC("DR"))_NFLD_"///"_FIELD(FILE,FLD)_";" Q

 ...I (NFLD=".19")!(NFLD=".12")!(NFLD=".08") S DIC("DR")=$G(DIC("DR"))_NFLD_"///"_FIELD(FILE,FLD)_";" Q  ;AG*7.1*2

 ...S DIC("DR")=$G(DIC("DR"))_NFLD_"////"_FIELD(FILE,FLD)_";"

 .S DIC("DR")=DIC("DR")_".02////"_PATPTR

 .S DIC("DR")=DIC("DR")_";.03////"_AGINSPTR

 .S X=FIELD("2",".01")

 .S DIC(0)="LFZ"

 .S DIC="^AUPN3PPH("

 .K DO,DD,DINUM

 .D FILE^DICN

 .S POLHPTR=+Y

 .I POLHPTR<0 D DISPHLP(ID0,.FIELD) S EXIT=1

 .K DIC,DIE,DA,DIR,DO,DD,DINUM,X

 S TYPE="E"

 I POLHPTR<0 S EXIT=1 Q

 W !!

 D PHEDALL^AGEDPRVP(PATPTR,INSPTR,POLHPTR,SAME,TYPE)

 S EXIT=0

 Q

AGEDPRV1  ;IHS/ASDS/TPF - EDIT/DISPLAY PRIVATE INSURANCE PAGE A OVERFLOW CODE ;    

 +1       ;;7.1;PATIENT REGISTRATION;**1,2,3**;APR 3, 2007

 +2       ;

 +3        QUIT 

 +4       ;CALLED FROM AGEDPRV

NOTREG(POLHPTR) ;EP - IS THIS POLICY HOLDER REGISTERED?

 +1        IF '$GET(POLHPTR)

               WRITE !,"NO POLICY HOLDER!"

               QUIT 

 +2        NEW PATPTR

 +3        SET PATPTR=$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,2)

 +4        IF $GET(PATPTR)'=""

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

                   WRITE " [NOT REG]"

 +5        IF PATPTR=""

               WRITE " [NOT REG]"

 +6        QUIT 

 +7       ;CALLED FROM AGEDPRV

DISPHLP(ID0,FIELD) ;EP -

 +1        WRITE !!,"DATA COULD NOT BE TRANSFERRED TO THE POLICY HOLDER FILE!"

 +2        WRITE !!,"DATA IMPROPERLY FORMATTED"

 +3        QUIT 

 +4       ;CALLED FROM AGEDPRV

CONFIRM   ;EP -

 +1        KILL DIR

 +2        SET DIR(0)="Y"

 +3        SET DIR("A")="Do you wish to add "_$GET(TARGET)_" as the Insured Policy Holder"

 +4        DO ^DIR

 +5        IF 'Y

               KILL POLHPTR,NEWPTR

               SET EXIT=1

               QUIT 

 +6       ;I 'Y D CLEAN11(ID0,ID1) K POLHPTR,NEWPTR S EXIT=1 Q  ;AG*7.1*3 IM23566

 +7        IF $GET(REGISTER)

               QUIT 

 +8        DO ADDPOLH^AGEDPRVP(ID0,ID1,$GET(TARGET),.POLHPTR,REGISTER,SAME)

 +9        QUIT 

 +10      ;CALLED FROM AGEDPRV

PUTPOLH(NEWPH,PATPTR,POLHPTR,TYPE,FIELD,SAME,EXIT,INSPTR) ;EP -

 +1       ;IF NEW POL HOLD. STUFF PT INTO NEW PH ENTRY

 +2        IF TYPE="NEW"

               Begin DoDot:1

 +3                KILL DIC,DIE,DA,DIR,DO,DD,DINUM,X,DR

 +4                SET FILE=""

 +5                FOR 

                       SET FILE=$ORDER(FIELD(FILE))

                       IF FILE=""

                           QUIT 

                       Begin DoDot:2

 +6                        SET FLD=""

 +7                        FOR 

                               SET FLD=$ORDER(FIELD(FILE,FLD))

                               IF FLD=""

                                   QUIT 

                               Begin DoDot:3

 +8                                IF FILE=2

                                       SET NFLD=$SELECT(FLD=.01:.01,FLD=.111:.09,FLD=.114:.11,FLD=.115:.12,FLD=.116:.13,FLD=.131:.14,FLD=.02:.08,FLD=.03:.19,FLD=.21:.15,1:99999)

 +9                                IF FILE=9000001

                                       SET NFLD=$SELECT(FLD=.19:.16,FLD=.21:.15,1:9999999)

 +10      ;Q:'$D(X)

                                   IF FIELD(FILE,FLD)'=""

                                       SET X=FIELD(FILE,FLD)

                                       XECUTE $PIECE(^DD(9000003.1,NFLD,0),U,5,999)

                                       IF '$DATA(X)

                                           WRITE !,"PROBLEM WITH FIELD ",NFLD," IN FILE ",FILE," THE DATA IS ",FIELD(FILE,FLD)

                                           QUIT 

 +11      ;W !,"FIELD "_NFLD_" IN FILE "_FILE_" PASSES INPUT TRANSFORM: "_FIELD(FILE,FLD)

 +12      ;I NFLD=".19" S DIC("DR")=$G(DIC("DR"))_NFLD_"///"_FIELD(FILE,FLD)_";" Q

 +13      ;AG*7.1*2

                                   IF (NFLD=".19")!(NFLD=".12")!(NFLD=".08")

                                       SET DIC("DR")=$GET(DIC("DR"))_NFLD_"///"_FIELD(FILE,FLD)_";"

                                       QUIT 

 +14                               SET DIC("DR")=$GET(DIC("DR"))_NFLD_"////"_FIELD(FILE,FLD)_";"

                               End DoDot:3

                       End DoDot:2

                       IF $GET(EXIT)

                           QUIT 

 +15               SET DIC("DR")=DIC("DR")_".02////"_PATPTR

 +16               SET DIC("DR")=DIC("DR")_";.03////"_AGINSPTR

 +17               SET X=FIELD("2",".01")

 +18               SET DIC(0)="LFZ"

 +19               SET DIC="^AUPN3PPH("

 +20               KILL DO,DD,DINUM

 +21               DO FILE^DICN

 +22               SET POLHPTR=+Y

 +23               IF POLHPTR<0

                       DO DISPHLP(ID0,.FIELD)

                       SET EXIT=1

 +24               KILL DIC,DIE,DA,DIR,DO,DD,DINUM,X

               End DoDot:1

 +25       SET TYPE="E"

 +26       IF POLHPTR<0

               SET EXIT=1

               QUIT 

 +27       WRITE !!

 +28       DO PHEDALL^AGEDPRVP(PATPTR,INSPTR,POLHPTR,SAME,TYPE)

 +29       SET EXIT=0

 +30       QUIT