- AGTMPMRG ; IHS/ASDS/EFG - MERGE POLICY HOLDERS ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- ;
- S U="^"
- SEL W !
- K DTOUT,DUOUT
- K DIC S AG("MODE")="SEL"
- S AG("XIT")=0,DIC="^AUPN3PPH(",DIC(0)="QEA",DIC("A")="Select POLICY HOLDER (to Search against): ",D="B^C^D" D MIX^DIC1 K DIC
- G XIT:X=""!$D(DTOUT)!$D(DUOUT)
- I +Y<1 G SEL
- I '$D(^AUPN3PPH(+Y,0)) W *7 K ^AUPN3PPH("B",$P(Y,U,2),+Y) G SEL
- S AG("X")=+Y,AG("X0")=^AUPN3PPH(+Y,0)
- D CHK
- G XIT:AG("XIT"),SEL
- CHK W !!,"Dup-Check for: ",$P(AG("X0"),U),!?15
- S AG("PDFN")=$P(AG("X0"),U,2) D HRN
- W !?15,$P($G(^AUTNINS($P(AG("X0"),U,3),0)),U)
- W !,"================================================"
- S DIC="^AUPN3PPH(",DIC(0)="QEAM",DIC("S")="I Y'=AG(""X""),$P(^(0),U,3)=$P(AG(""X0""),U,3)",DIC("A")="Select (SEARCH) for Duplicate POLICY HOLDER: " D ^DIC K DIC
- I $D(DTOUT)!$D(DUOUT) S AG("XIT")=1 Q
- I +Y<1 W *7,!,"No other Policy Holders having the same insurer found.",! G CONT
- S AG("Y")=+Y,AG("Y0")=^AUPN3PPH(+Y,0)
- DISP W !,"_______________________________________________________________________________"
- W !,"[1] ",$P(AG("X0"),U),?39,"| [2] ",$P(AG("Y0"),U)
- W !," " S AG("PDFN")=$P(AG("X0"),U,2) D HRN
- W ?39,"| " S AG("PDFN")=$P(AG("Y0"),U,2) D HRN
- W !,"-------------------------------------------------------------------------------"
- W !!,"The CRT Screen will display each of the Policy Holders in turn ",!,"until you enter an ""^"" to end the displays.",!
- S DIR(0)="E" D ^DIR
- G:($G(DUOUT)!$G(DTOUT)!$G(DIROUT)) CONT
- K DTOUT,DUOUT,DROUT,DIROUT
- F D Q:($G(DUOUT)!$G(DTOUT)!$G(DIROUT))
- .S AGELP("PH")=AG("X"),AGELP("INS")=$P(AG("X0"),U,3) D ^AGELA
- .W !!!,"Above Information for [1] ",$P(AG("X0"),U)," ",$P(AG("X0"),U,4),!!
- .S DIR(0)="E" D ^DIR
- .Q:($G(DUOUT)!$G(DTOUT)!$G(DIROUT))
- .S AGELP("PH")=AG("Y"),AGELP("INS")=$P(AG("Y0"),U,3) D ^AGELA
- .Q:($G(DUOUT)!$G(DTOUT)!$G(DIROUT))
- .W !!!,"Above Information for [2] ",$P(AG("Y0"),U)," ",$P(AG("Y0"),U,4),!!
- .S DIR(0)="E" D ^DIR
- K AGELP
- W ! K DIR S DIR(0)="Y",DIR("A")=" Are the two POLICY HOLDERS duplicates (Y/N)" D ^DIR K DIR I Y'=1 G CONT
- W ! K DIR S DIR(0)="SO^1:"_$P(AG("X0"),U)_" "_$P(AG("X0"),U,4)_";2:"_$P(AG("Y0"),U)_" "_$P(AG("Y0"),U,4),DIR("A")=" Which of the two is most accurate" D ^DIR K DIR I Y=1!(Y=2) G MOVE
- CONT W !! K DIR S DIR(0)="Y",DIR("A")="Do you want to dup-check "_$P(AG("X0"),U)_" any more",DIR("B")="Y" D ^DIR K DIR I Y=1 G CHK
- VERF W !! K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue running this program",DIR("B")="Y" D ^DIR K DIR I Y'=1 S AG("XIT")=1
- Q
- MOVE ;
- I Y=1 S AG=AG("X"),AG("X")=AG("Y"),AG("Y")=AG
- D MV2 G VERF
- MV1 S %X="^AUPN3PPH("_AG("X")_","
- S %Y="^AUPN3PPH("_AG("Y")_","
- D %XY^%RCR
- S DA=AG("Y"),DIK="^AUPN3PPH(" D IX1^DIK
- MV2 S DIK="^AUPN3PPH(",DA=AG("X") D ^DIK
- W !!,"Re-directing Pointers..."
- S DA(1)=0 F S DA(1)=$O(^AUPNPRVT("C",AG("X"),DA(1))) Q:'DA(1) D
- .S DA=0 F S DA=$O(^AUPNPRVT("C",AG("X"),DA(1),DA)) Q:'DA D
- ..S DIE="^AUPNPRVT("_DA(1)_",11,"
- ..I $D(^AUPNPRVT("C",AG("Y"),DA(1))) S DIK=DIE D ^DIK Q
- ..S DR=".08////"_AG("Y") D ^DIE K DR
- Q
- HRN W "(HRN: ",$S('$G(AG("PDFN")):"not Registered",'$G(DUZ(2)):"DUZ(2) undefined",$P($G(^AUPNPAT(AG("PDFN"),41,DUZ(2),0)),U,2):$P(^(0),U,2),1:"no HRN at "_$P(^AUTTLOC(DUZ(2),0),U,2)),")"
- Q
- XIT K AG
- Q
- AGTMPMRG ; IHS/ASDS/EFG - MERGE POLICY HOLDERS ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 ;
- +3 SET U="^"
- SEL WRITE !
- +1 KILL DTOUT,DUOUT
- +2 KILL DIC
- SET AG("MODE")="SEL"
- +3 SET AG("XIT")=0
- SET DIC="^AUPN3PPH("
- SET DIC(0)="QEA"
- SET DIC("A")="Select POLICY HOLDER (to Search against): "
- SET D="B^C^D"
- DO MIX^DIC1
- KILL DIC
- +4 IF X=""!$DATA(DTOUT)!$DATA(DUOUT)
- GOTO XIT
- +5 IF +Y<1
- GOTO SEL
- +6 IF '$DATA(^AUPN3PPH(+Y,0))
- WRITE *7
- KILL ^AUPN3PPH("B",$PIECE(Y,U,2),+Y)
- GOTO SEL
- +7 SET AG("X")=+Y
- SET AG("X0")=^AUPN3PPH(+Y,0)
- +8 DO CHK
- +9 IF AG("XIT")
- GOTO XIT
- GOTO SEL
- CHK WRITE !!,"Dup-Check for: ",$PIECE(AG("X0"),U),!?15
- +1 SET AG("PDFN")=$PIECE(AG("X0"),U,2)
- DO HRN
- +2 WRITE !?15,$PIECE($GET(^AUTNINS($PIECE(AG("X0"),U,3),0)),U)
- +3 WRITE !,"================================================"
- +4 SET DIC="^AUPN3PPH("
- SET DIC(0)="QEAM"
- SET DIC("S")="I Y'=AG(""X""),$P(^(0),U,3)=$P(AG(""X0""),U,3)"
- SET DIC("A")="Select (SEARCH) for Duplicate POLICY HOLDER: "
- DO ^DIC
- KILL DIC
- +5 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET AG("XIT")=1
- QUIT
- +6 IF +Y<1
- WRITE *7,!,"No other Policy Holders having the same insurer found.",!
- GOTO CONT
- +7 SET AG("Y")=+Y
- SET AG("Y0")=^AUPN3PPH(+Y,0)
- DISP WRITE !,"_______________________________________________________________________________"
- +1 WRITE !,"[1] ",$PIECE(AG("X0"),U),?39,"| [2] ",$PIECE(AG("Y0"),U)
- +2 WRITE !," "
- SET AG("PDFN")=$PIECE(AG("X0"),U,2)
- DO HRN
- +3 WRITE ?39,"| "
- SET AG("PDFN")=$PIECE(AG("Y0"),U,2)
- DO HRN
- +4 WRITE !,"-------------------------------------------------------------------------------"
- +5 WRITE !!,"The CRT Screen will display each of the Policy Holders in turn ",!,"until you enter an ""^"" to end the displays.",!
- +6 SET DIR(0)="E"
- DO ^DIR
- +7 IF ($GET(DUOUT)!$GET(DTOUT)!$GET(DIROUT))
- GOTO CONT
- +8 KILL DTOUT,DUOUT,DROUT,DIROUT
- +9 FOR
- Begin DoDot:1
- +10 SET AGELP("PH")=AG("X")
- SET AGELP("INS")=$PIECE(AG("X0"),U,3)
- DO ^AGELA
- +11 WRITE !!!,"Above Information for [1] ",$PIECE(AG("X0"),U)," ",$PIECE(AG("X0"),U,4),!!
- +12 SET DIR(0)="E"
- DO ^DIR
- +13 IF ($GET(DUOUT)!$GET(DTOUT)!$GET(DIROUT))
- QUIT
- +14 SET AGELP("PH")=AG("Y")
- SET AGELP("INS")=$PIECE(AG("Y0"),U,3)
- DO ^AGELA
- +15 IF ($GET(DUOUT)!$GET(DTOUT)!$GET(DIROUT))
- QUIT
- +16 WRITE !!!,"Above Information for [2] ",$PIECE(AG("Y0"),U)," ",$PIECE(AG("Y0"),U,4),!!
- +17 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- IF ($GET(DUOUT)!$GET(DTOUT)!$GET(DIROUT))
- QUIT
- +18 KILL AGELP
- +19 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")=" Are the two POLICY HOLDERS duplicates (Y/N)"
- DO ^DIR
- KILL DIR
- IF Y'=1
- GOTO CONT
- +20 WRITE !
- KILL DIR
- SET DIR(0)="SO^1:"_$PIECE(AG("X0"),U)_" "_$PIECE(AG("X0"),U,4)_";2:"_$PIECE(AG("Y0"),U)_" "_$PIECE(AG("Y0"),U,4)
- SET DIR("A")=" Which of the two is most accurate"
- DO ^DIR
- KILL DIR
- IF Y=1!(Y=2)
- GOTO MOVE
- CONT WRITE !!
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to dup-check "_$PIECE(AG("X0"),U)_" any more"
- SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- IF Y=1
- GOTO CHK
- VERF WRITE !!
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish to continue running this program"
- SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- IF Y'=1
- SET AG("XIT")=1
- +1 QUIT
- MOVE ;
- +1 IF Y=1
- SET AG=AG("X")
- SET AG("X")=AG("Y")
- SET AG("Y")=AG
- +2 DO MV2
- GOTO VERF
- MV1 SET %X="^AUPN3PPH("_AG("X")_","
- +1 SET %Y="^AUPN3PPH("_AG("Y")_","
- +2 DO %XY^%RCR
- +3 SET DA=AG("Y")
- SET DIK="^AUPN3PPH("
- DO IX1^DIK
- MV2 SET DIK="^AUPN3PPH("
- SET DA=AG("X")
- DO ^DIK
- +1 WRITE !!,"Re-directing Pointers..."
- +2 SET DA(1)=0
- FOR
- SET DA(1)=$ORDER(^AUPNPRVT("C",AG("X"),DA(1)))
- IF 'DA(1)
- QUIT
- Begin DoDot:1
- +3 SET DA=0
- FOR
- SET DA=$ORDER(^AUPNPRVT("C",AG("X"),DA(1),DA))
- IF 'DA
- QUIT
- Begin DoDot:2
- +4 SET DIE="^AUPNPRVT("_DA(1)_",11,"
- +5 IF $DATA(^AUPNPRVT("C",AG("Y"),DA(1)))
- SET DIK=DIE
- DO ^DIK
- QUIT
- +6 SET DR=".08////"_AG("Y")
- DO ^DIE
- KILL DR
- End DoDot:2
- End DoDot:1
- +7 QUIT
- HRN WRITE "(HRN: ",$SELECT('$GET(AG("PDFN")):"not Registered",'$GET(DUZ(2)):"DUZ(2) undefined",$PIECE($GET(^AUPNPAT(AG("PDFN"),41,DUZ(2),0)),U,2):$PIECE(^(0),U,2),1:"no HRN at "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)),")"
- +1 QUIT
- XIT KILL AG
- +1 QUIT
