AGEDPRVI ;IHS/ASDS/TPF - EDIT PRIVATE INSURANCE ELIGIBLE FIELDS ;
;;7.1;PATIENT REGISTRATION;**1,2,8**;AUG 25, 2005
;ALL CALLS TO THIS ROUTINE WILL BE FOR EEDITING POLICY HOLDER FIELDS
;
Q
EDITPOLM(POLMEMBS,CHOICES) ;EP - EDIT POLICY MEMBER INSURANCE INFORMATION
EDITPOL2 ;EP -
N PIECE,ITEM,RECORD,INSPTR
N AGOLDDT,AGNEWDT
F PIECE=1:1 S ITEM=$P(CHOICES,",",PIECE) Q:ITEM="" D
.S POLMPTR=$O(POLMEMBS(ITEM,""))
.S INSPTR=$O(POLMEMBS(ITEM,POLMPTR,""))
.W !!,"Policy Member: ",$P($G(^DPT(POLMPTR,0)),U)
.K DIC,DA,DIR,DIE,DIR,DR
.;S DR="05R~Relationship to Insured..: ;.06Starting Date.. : ;.07Expiration Date...: ;.12Person Code...: ;21Member Number:" ;AG*7.1*2 ALPHA TESTING
.S DR="05R~Relationship to Insured..: ;.06R~Starting Date.. : ;.07Expiration Date...: ;.12Person Code...: ;21Member Number:"
.S AGOLDDT=$$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I","AGDATA","AGERR")
.S DA=INSPTR
.S DA(1)=POLMPTR
.S DIE="^AUPNPRVT("_DA(1)_",11,"
.D ^DIE
.;AG*7.1*2 FOUND IN TESTING. CHANGE WILL BE MADE TO DD FOR AUPNPRVT
.I $$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I"),($$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.06,"I")>$$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I")) D G EDITPOL2
..W !!,"STARTING DATE CANNOT BE AFTER TERMINATION DATE!" H 2
.S AGNEWDT=$$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I","AGDATA","AGERR")
.K DIC,DA,DIR,DIE,DR
.;AG*7.1*2 REQUESTED DURING TESTING ALSO IM20317
.Q:AGOLDDT=AGNEWDT ;NO UPDATE IF THERE WAS NO CHANGE MADE
.Q:$G(POLMEMBS("SELF"))="" ;IF NO SELF THEN POLICY HOLDER IS NOT LISTED IN THE MEMBER SECTION
.I ($G(POLMPTR)=$G(POLMEMBS("SELF"))) D
..D UPDTERM^AGEDPRVP(AGELP("PH"),AGNEWDT,AGOLDDT)
..K DIC,DA,DIR,DIE,DR
..I AGNEWDT="" S DR=".18///@"
..E S DR=".18///^S X=AGNEWDT"
..S DIE="^AUPN3PPH("
..S DA=AGELP("PH")
..D ^DIE
..K DIC,DA,DIR,DIE,DR
Q
ADDOPT(PATPTR,INSPTR,POLHPTR,POLMEMBS) ;EP - ADD MEMBER FORM PRVT PAGE A
K DIE,DIC,DR,DIR,DA
S DR=".12 Person Code..: ;.14 Primary Care Provider...: ;21 Member Number..: ;.15 Card Copy Obtained (Y/N)?..: "
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIE,DIC,DR,DIR,DA
I $P($G(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,15)="Y" D
.K DIE,DIC,DR,DIR,DA
.S DIE("NO^")=""
.S DR=".16R~ Date CC Obtained..: "
.S DA=INSPTR
.S DA(1)=PATPTR
.S DIE="^AUPNPRVT("_DA(1)_",11,"
.D ^DIE
.K DIE,DIC,DR,DIR,DA
I $P($G(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,15)="N" D
.K DIE,DIC,DR,DIR,DA
.S DR=".16////@"
.S DA=INSPTR
.S DA(1)=PATPTR
.S DIE="^AUPNPRVT("_DA(1)_",11,"
.D ^DIE
REL ;EP - EDIT RELATIONSHIP TO INSURER
K DIE,DIC,DR,DIR,DA
S DR=".05R~ Relationship to Insured..: "
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
I $D(POLMEMBS("SELF")),($P($G(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,5)=25) D G REL
.W !!,"THERE IS ALREADY A POLICY HOLDER FOR THIS POLICY!!"
.S $P(^AUPNPRVT(PATPTR,11,INSPTR,0),U,5)=""
K DIE,DIC,DR,DIR,DA
;STUFF ADDITIONAL ITEMS THAT WE CAN
D EDITPOLN(PATPTR,INSPTR,POLHPTR)
D EDITCON(PATPTR,INSPTR,POLHPTR)
D EDITBDT(PATPTR,INSPTR,POLHPTR,"S")
D EDITEDT(PATPTR,INSPTR,POLHPTR,"S")
D EDITPH(PATPTR,INSPTR,POLHPTR)
D EDITNAME(PATPTR,INSPTR,POLHPTR,"S")
Q
EDITPCD(PATPTR,INSPTR) ;EP - EDIT PERSON CODE
K DIC,DA,DIR,DIE,DIR,DR
S DR=".12 Person Code...: "
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
EDITMNUM(PATPTR,INSPTR) ;EP - EDIT MEMBER NUMBER
K DIC,DA,DIR,DIE,DIR,DR
S DR="21 Member Number..: "
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
EDITPOLN(PATPTR,INSPTR,POLHPTR) ;EP - STUFF POLICY NUMBER
K DIC,DA,DIR,DIE,DIR,DR
I $G(POLHPTR) S DR=".02////"_$P($G(^AUPN3PPH(POLHPTR,0)),U,4)
E S DR=.02
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
EDITCON(PATPTR,INSPTR,POLHPTR) ;EP - STUFF COVERAGE PTR
K DIC,DA,DIR,DIE,DIR,DR
I $G(POLHPTR) S DR=".03////"_$P($G(^AUPN3PPH(POLHPTR,0)),U,5)
E S DR=.03
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
EDITBDT(PATPTR,INSPTR,POLHPTR,TYPE) ;EP - STUFF ELIG BEGIN DATE
K DIC,DA,DIR,DIE,DIR,DR
I $G(POLHPTR),($G(TYPE)="S") S DR=".06////"_$P($G(^AUPN3PPH(POLHPTR,0)),U,17)
E S DR=".06 Sarting Date.. : "
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
EDITEDT(PATPTR,INSPTR,POLHPTR,TYPE) ;EP - STUFF ELIG END DATE
K DIC,DA,DIR,DIE,DIR,DR
I $G(POLHPTR),($G(TYPE)="S") S DR=".07////"_$P($G(^AUPN3PPH(POLHPTR,0)),U,18)
E S DR=".07 Expiration Date...: "
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
EDITPH(PATPTR,INSPTR,POLHPTR) ;EP - STUFF POLICY HOLDER PTR
K DIC,DA,DIR,DIE,DIR,DR
I $G(POLHPTR) S DR=".08////"_POLHPTR
E S DR=.08
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
EDITNAME(PATPTR,INSPTR,POLHPTR,TYPE) ;EP - STUFF POLICY HOLDER NAME
K DIC,DA,DIR,DIE,DIR,DR
I $G(POLHPTR),($G(TYPE)="S") S DR=".04////"_$P($G(^AUPN3PPH(POLHPTR,0)),U)
E I $G(TYPE)="E" S DR=".04Name as Stated on Policy..: //"
E S DR=".04"
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
EDITREL(PATPTR,INSPTR,SAME) ;EP - EDIT/STUFF RELATIONSHIP PTR
K DIC,DA,DIR,DIE,DIR,DR
;CHECK HERE FOR SAME
I $G(SAME) S DR=".05///SELF"
E S DR=".05R~Relationship to Insured..: "
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
EDITPCP(PATPTR,INSPTR,CALLER) ;EP - EDIT PRIMARY CARE PROVIDER
K DR,DIE,DIC,DA,DIR,DR
I $G(CALLER)="SCREEN" W !!
S DA(1)=PATPTR
S DA=INSPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
S DR=".14[7] PCP: " ;AG*7.1*8
D ^DIE
K DR,DIE,DIC,DA,DIR,DR
Q
EDITCC(PATPTR,INSPTR,CALLER) ;EP - EDIT CARD COPY ON FILE/ DATE RECEIVED
K DIE,DIC,DR,DA,DIR,DR
I $G(CALLER)="SCREEN" W !!
S DA(1)=PATPTR
S DA=INSPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
S DR=".15[13] Card Copy on file: "
D ^DIE
I $P($G(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,15)[("Y") D EDITCCDT(PATPTR,INSPTR)
K DIE,DIC,DR,DA,DIR,DR
Q
EDITCCDT(PATPTR,INSPTR) ;EP - EDIT CARD COPY DATE
K DIC,DA,DIR,DIE,DIR,DR
S DIE("NO^")=""
S DR=".16R~ Date CC obtained..:"
S DA=INSPTR
S DA(1)=PATPTR
S DIE="^AUPNPRVT("_DA(1)_",11,"
D ^DIE
K DIC,DA,DIR,DIE,DIR,DR
Q
AGEDPRVI ;IHS/ASDS/TPF - EDIT PRIVATE INSURANCE ELIGIBLE FIELDS ;
+1 ;;7.1;PATIENT REGISTRATION;**1,2,8**;AUG 25, 2005
+2 ;ALL CALLS TO THIS ROUTINE WILL BE FOR EEDITING POLICY HOLDER FIELDS
+3 ;
+4 QUIT
EDITPOLM(POLMEMBS,CHOICES) ;EP - EDIT POLICY MEMBER INSURANCE INFORMATION
EDITPOL2 ;EP -
+1 NEW PIECE,ITEM,RECORD,INSPTR
+2 NEW AGOLDDT,AGNEWDT
+3 FOR PIECE=1:1
SET ITEM=$PIECE(CHOICES,",",PIECE)
IF ITEM=""
QUIT
Begin DoDot:1
+4 SET POLMPTR=$ORDER(POLMEMBS(ITEM,""))
+5 SET INSPTR=$ORDER(POLMEMBS(ITEM,POLMPTR,""))
+6 WRITE !!,"Policy Member: ",$PIECE($GET(^DPT(POLMPTR,0)),U)
+7 KILL DIC,DA,DIR,DIE,DIR,DR
+8 ;S DR="05R~Relationship to Insured..: ;.06Starting Date.. : ;.07Expiration Date...: ;.12Person Code...: ;21Member Number:" ;AG*7.1*2 ALPHA TESTING
+9 SET DR="05R~Relationship to Insured..: ;.06R~Starting Date.. : ;.07Expiration Date...: ;.12Person Code...: ;21Member Number:"
+10 SET AGOLDDT=$$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I","AGDATA","AGERR")
+11 SET DA=INSPTR
+12 SET DA(1)=POLMPTR
+13 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+14 DO ^DIE
+15 ;AG*7.1*2 FOUND IN TESTING. CHANGE WILL BE MADE TO DD FOR AUPNPRVT
+16 IF $$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I")
IF ($$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.06,"I")>$$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I"))
Begin DoDot:2
+17 WRITE !!,"STARTING DATE CANNOT BE AFTER TERMINATION DATE!"
HANG 2
End DoDot:2
GOTO EDITPOL2
+18 SET AGNEWDT=$$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I","AGDATA","AGERR")
+19 KILL DIC,DA,DIR,DIE,DR
+20 ;AG*7.1*2 REQUESTED DURING TESTING ALSO IM20317
+21 ;NO UPDATE IF THERE WAS NO CHANGE MADE
IF AGOLDDT=AGNEWDT
QUIT
+22 ;IF NO SELF THEN POLICY HOLDER IS NOT LISTED IN THE MEMBER SECTION
IF $GET(POLMEMBS("SELF"))=""
QUIT
+23 IF ($GET(POLMPTR)=$GET(POLMEMBS("SELF")))
Begin DoDot:2
+24 DO UPDTERM^AGEDPRVP(AGELP("PH"),AGNEWDT,AGOLDDT)
+25 KILL DIC,DA,DIR,DIE,DR
+26 IF AGNEWDT=""
SET DR=".18///@"
+27 IF '$TEST
SET DR=".18///^S X=AGNEWDT"
+28 SET DIE="^AUPN3PPH("
+29 SET DA=AGELP("PH")
+30 DO ^DIE
+31 KILL DIC,DA,DIR,DIE,DR
End DoDot:2
End DoDot:1
+32 QUIT
ADDOPT(PATPTR,INSPTR,POLHPTR,POLMEMBS) ;EP - ADD MEMBER FORM PRVT PAGE A
+1 KILL DIE,DIC,DR,DIR,DA
+2 SET DR=".12 Person Code..: ;.14 Primary Care Provider...: ;21 Member Number..: ;.15 Card Copy Obtained (Y/N)?..: "
+3 SET DA=INSPTR
+4 SET DA(1)=PATPTR
+5 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+6 DO ^DIE
+7 KILL DIE,DIC,DR,DIR,DA
+8 IF $PIECE($GET(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,15)="Y"
Begin DoDot:1
+9 KILL DIE,DIC,DR,DIR,DA
+10 SET DIE("NO^")=""
+11 SET DR=".16R~ Date CC Obtained..: "
+12 SET DA=INSPTR
+13 SET DA(1)=PATPTR
+14 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+15 DO ^DIE
+16 KILL DIE,DIC,DR,DIR,DA
End DoDot:1
+17 IF $PIECE($GET(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,15)="N"
Begin DoDot:1
+18 KILL DIE,DIC,DR,DIR,DA
+19 SET DR=".16////@"
+20 SET DA=INSPTR
+21 SET DA(1)=PATPTR
+22 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+23 DO ^DIE
End DoDot:1
REL ;EP - EDIT RELATIONSHIP TO INSURER
+1 KILL DIE,DIC,DR,DIR,DA
+2 SET DR=".05R~ Relationship to Insured..: "
+3 SET DA=INSPTR
+4 SET DA(1)=PATPTR
+5 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+6 DO ^DIE
+7 IF $DATA(POLMEMBS("SELF"))
IF ($PIECE($GET(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,5)=25)
Begin DoDot:1
+8 WRITE !!,"THERE IS ALREADY A POLICY HOLDER FOR THIS POLICY!!"
+9 SET $PIECE(^AUPNPRVT(PATPTR,11,INSPTR,0),U,5)=""
End DoDot:1
GOTO REL
+10 KILL DIE,DIC,DR,DIR,DA
+11 ;STUFF ADDITIONAL ITEMS THAT WE CAN
+12 DO EDITPOLN(PATPTR,INSPTR,POLHPTR)
+13 DO EDITCON(PATPTR,INSPTR,POLHPTR)
+14 DO EDITBDT(PATPTR,INSPTR,POLHPTR,"S")
+15 DO EDITEDT(PATPTR,INSPTR,POLHPTR,"S")
+16 DO EDITPH(PATPTR,INSPTR,POLHPTR)
+17 DO EDITNAME(PATPTR,INSPTR,POLHPTR,"S")
+18 QUIT
EDITPCD(PATPTR,INSPTR) ;EP - EDIT PERSON CODE
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 SET DR=".12 Person Code...: "
+3 SET DA=INSPTR
+4 SET DA(1)=PATPTR
+5 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+6 DO ^DIE
+7 KILL DIC,DA,DIR,DIE,DIR,DR
+8 QUIT
EDITMNUM(PATPTR,INSPTR) ;EP - EDIT MEMBER NUMBER
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 SET DR="21 Member Number..: "
+3 SET DA=INSPTR
+4 SET DA(1)=PATPTR
+5 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+6 DO ^DIE
+7 KILL DIC,DA,DIR,DIE,DIR,DR
+8 QUIT
EDITPOLN(PATPTR,INSPTR,POLHPTR) ;EP - STUFF POLICY NUMBER
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 IF $GET(POLHPTR)
SET DR=".02////"_$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,4)
+3 IF '$TEST
SET DR=.02
+4 SET DA=INSPTR
+5 SET DA(1)=PATPTR
+6 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+7 DO ^DIE
+8 KILL DIC,DA,DIR,DIE,DIR,DR
+9 QUIT
EDITCON(PATPTR,INSPTR,POLHPTR) ;EP - STUFF COVERAGE PTR
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 IF $GET(POLHPTR)
SET DR=".03////"_$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,5)
+3 IF '$TEST
SET DR=.03
+4 SET DA=INSPTR
+5 SET DA(1)=PATPTR
+6 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+7 DO ^DIE
+8 KILL DIC,DA,DIR,DIE,DIR,DR
+9 QUIT
EDITBDT(PATPTR,INSPTR,POLHPTR,TYPE) ;EP - STUFF ELIG BEGIN DATE
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 IF $GET(POLHPTR)
IF ($GET(TYPE)="S")
SET DR=".06////"_$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,17)
+3 IF '$TEST
SET DR=".06 Sarting Date.. : "
+4 SET DA=INSPTR
+5 SET DA(1)=PATPTR
+6 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+7 DO ^DIE
+8 KILL DIC,DA,DIR,DIE,DIR,DR
+9 QUIT
EDITEDT(PATPTR,INSPTR,POLHPTR,TYPE) ;EP - STUFF ELIG END DATE
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 IF $GET(POLHPTR)
IF ($GET(TYPE)="S")
SET DR=".07////"_$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,18)
+3 IF '$TEST
SET DR=".07 Expiration Date...: "
+4 SET DA=INSPTR
+5 SET DA(1)=PATPTR
+6 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+7 DO ^DIE
+8 KILL DIC,DA,DIR,DIE,DIR,DR
+9 QUIT
EDITPH(PATPTR,INSPTR,POLHPTR) ;EP - STUFF POLICY HOLDER PTR
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 IF $GET(POLHPTR)
SET DR=".08////"_POLHPTR
+3 IF '$TEST
SET DR=.08
+4 SET DA=INSPTR
+5 SET DA(1)=PATPTR
+6 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+7 DO ^DIE
+8 KILL DIC,DA,DIR,DIE,DIR,DR
+9 QUIT
EDITNAME(PATPTR,INSPTR,POLHPTR,TYPE) ;EP - STUFF POLICY HOLDER NAME
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 IF $GET(POLHPTR)
IF ($GET(TYPE)="S")
SET DR=".04////"_$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U)
+3 IF '$TEST
IF $GET(TYPE)="E"
SET DR=".04Name as Stated on Policy..: //"
+4 IF '$TEST
SET DR=".04"
+5 SET DA=INSPTR
+6 SET DA(1)=PATPTR
+7 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+8 DO ^DIE
+9 KILL DIC,DA,DIR,DIE,DIR,DR
+10 QUIT
EDITREL(PATPTR,INSPTR,SAME) ;EP - EDIT/STUFF RELATIONSHIP PTR
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 ;CHECK HERE FOR SAME
+3 IF $GET(SAME)
SET DR=".05///SELF"
+4 IF '$TEST
SET DR=".05R~Relationship to Insured..: "
+5 SET DA=INSPTR
+6 SET DA(1)=PATPTR
+7 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+8 DO ^DIE
+9 KILL DIC,DA,DIR,DIE,DIR,DR
+10 QUIT
EDITPCP(PATPTR,INSPTR,CALLER) ;EP - EDIT PRIMARY CARE PROVIDER
+1 KILL DR,DIE,DIC,DA,DIR,DR
+2 IF $GET(CALLER)="SCREEN"
WRITE !!
+3 SET DA(1)=PATPTR
+4 SET DA=INSPTR
+5 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+6 ;AG*7.1*8
SET DR=".14[7] PCP: "
+7 DO ^DIE
+8 KILL DR,DIE,DIC,DA,DIR,DR
+9 QUIT
EDITCC(PATPTR,INSPTR,CALLER) ;EP - EDIT CARD COPY ON FILE/ DATE RECEIVED
+1 KILL DIE,DIC,DR,DA,DIR,DR
+2 IF $GET(CALLER)="SCREEN"
WRITE !!
+3 SET DA(1)=PATPTR
+4 SET DA=INSPTR
+5 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+6 SET DR=".15[13] Card Copy on file: "
+7 DO ^DIE
+8 IF $PIECE($GET(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,15)[("Y")
DO EDITCCDT(PATPTR,INSPTR)
+9 KILL DIE,DIC,DR,DA,DIR,DR
+10 QUIT
EDITCCDT(PATPTR,INSPTR) ;EP - EDIT CARD COPY DATE
+1 KILL DIC,DA,DIR,DIE,DIR,DR
+2 SET DIE("NO^")=""
+3 SET DR=".16R~ Date CC obtained..:"
+4 SET DA=INSPTR
+5 SET DA(1)=PATPTR
+6 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+7 DO ^DIE
+8 KILL DIC,DA,DIR,DIE,DIR,DR
+9 QUIT
