- AUPNPCTR ; IHS/CMI/LAB - XREF TRIGGER FROM #1117 (RESIDENCE COMMUNITY PT) TO LAST PREVIOUS COMMUNITY 24-MAY-1993 ; [ 10/03/2007 8:57 AM ]
- ;;99.1;IHS DICTIONARIES (PATIENT);**6,9,10,18,19**;JUN 13, 2003;Build 9
- S ;ENTRY POINT FOR SET TRIGGERS
- S DFN=DA(1),AUPN51DA=DA NEW (DFN,DT,DUZ,U,AUPN51DA)
- D LD I AUPN5LD,AUPN5LD=AUPN51DA
- E G END ; quit if date being edited is not the last date
- D SET G END
- ;-------------------------------------------------
- K ;ENTRY POINT FOR KILL TRIGGER
- S DFN=DA(1),AUPN51DA=DA NEW (DFN,DT,DUZ,U,AUPN51DA)
- D LD I AUPN5LD,AUPN5LD=AUPN51DA
- E G END ;exit if day being deleted is not the last date
- ; find next to last date
- S (AUPN5,AUPN5NLD)=0 I ($D(^AUPNPAT(DFN,51))>1) F S AUPN5=$O(^AUPNPAT(DFN,51,AUPN5)) Q:'AUPN5 Q:AUPN5=AUPN5LD S AUPN5NLD=AUPN5
- S AUPN5LD=AUPN5NLD
- D SET G END
- ;
- ;------------------------------------------------------------
- LD ; find last date
- S (AUPN5,AUPN5LD)=0
- I ($D(^AUPNPAT(DFN,51))>1) F S AUPN5=$O(^AUPNPAT(DFN,51,AUPN5)) Q:'AUPN5 S AUPN5LD=AUPN5
- Q
- ;-------------------------------------------------
- SET ; Set Current Community , Current Residence PTR, Current Residence Date ; IHS/PAO/TMJ Fix of Subscript and DIE Call
- I AUPN5LD D I AUPNCC>0,AUPNCCN]""
- . S AUPNCC=$P($G(^AUPNPAT(DFN,51,AUPN5LD,0)),"^",3)
- . Q:AUPNCC=""
- . S AUPNCCN=$P($G(^AUTTCOM(AUPNCC,0)),U) ; pickup Current Community Pointer and name
- E S AUPNCC="@",AUPNCCN="@"
- S DIE="^AUPNPAT(",DA=DFN,DR="1118///"_AUPNCCN D ^DIE
- K AUPNTEMP("MFI",$J) S DR="1117///"_$S(AUPNCC="@":"",1:"`")_AUPNCC D ^DIE K AUPNTEMP("MFI",$J)
- S Y="@" I AUPN5LD S Y=AUPN5LD D DD^%DT
- S DR="1113///"_Y D ^DIE K AUPNTEMP("MFI",$J)
- Q
- ;------------------------------------------------------------
- END ;
- EXIT ; all entry points NEW (DFN,DUZ,DT,U) and exit here
- K AUPN51DA
- Q
- ;------------------------------------------------------------
- ;------------------------------------------------------------
- MFI ;ENTRY POINT FOR MFI
- Q:$G(XDRGID) ;IHS/OIT/LJF 02/28/2008 PATCH 19 skip if in Patient Merge
- S DFN=DA NEW (DFN,DT,DUZ,U,AUPN51DA,AUPNDOB,AUPNDOD,AUPNTEMP)
- I $D(AUPNTEMP("MFI",$J,DFN,1117)),$D(AUPNTEMP("MFI",$J,DFN,1113))
- E Q ; wait for both fields to be set by MFI
- D SETMFI K AUPNTEMP("MFI",$J,DFN)
- D LD D SET
- G END
- ;
- ;--------------------------------------------------
- SETMFI ;
- S:'$D(^AUPNPAT(DFN,51,0)) ^AUPNPAT(DFN,51,0)="^9000001.51D^^"
- S AUPNCC=$P(^AUPNPAT(DFN,11),U,17),AUPNDT=$P(^AUPNPAT(DFN,11),U,13)
- I $D(^AUPNPAT(DFN,51,AUPNDT,0)),$P(^(0),U)=AUPNDT,$P(^(0),U,3)=AUPNCC Q ; if node matches do not reset
- S AUPNX=0 F S AUPNX=$O(^AUPNPAT(DFN,51,AUPNX)) Q:'AUPNX S AUPNLPC=$P(^AUPNPAT(DFN,51,AUPNX,0),U,3),AUPNX1=AUPNX
- I $D(AUPNLPC),AUPNLPC=AUPNCC D DELCC
- S Y=AUPNDT D DD^%DT S X=Y,DIC="^AUPNPAT("_DFN_",51,",DIC(0)="ML",DA(1)=DFN D ^DIC K DIC,DR Q:'+Y
- S DA=AUPNDT,DA(1)=DFN,DIE="^AUPNPAT("_DFN_",51,",DR=".03////"_AUPNCC
- I $P(^AUPNPAT(DFN,51,DA,0),U,2)="" S DR=DR_";.02////"_DT
- D ^DIE
- Q
- ;
- DELCC ; Delete Last Previous community multiple
- S DA(1)=DFN,DA=AUPNX1,DIK="^AUPNPAT("_DA(1)_",51,"
- D ^DIK K DA,DIK
- Q
- ;
- LASTEM(PAT) ;EP - called from trigger on previous email field
- NEW A,B,C
- K B
- S C=""
- S A=0 F S A=$O(^AUPNPAT(PAT,82,A)) Q:A'=+A D
- .Q:$P(^AUPNPAT(PAT,82,A,0),U,1)="" ;no date yet
- .S B(9999999-$P(^AUPNPAT(PAT,82,A,0),U,1))=$P(^AUPNPAT(PAT,82,A,0),U,2)
- .Q
- S C=$O(B(0))
- I C Q B(C)
- Q ""
- ;
- LASTADDR(P,V) ;EP - called to update .111 in file 2
- NEW A,B,C
- K B
- S A=0,C="" F S A=$O(^AUPNPAT(P,83,A)) Q:A'=+A D
- .Q:$P(^AUPNPAT(P,83,A,0),U,1)="" ;no date yet
- .S B(9999999-$P(^AUPNPAT(P,83,A,0),U,1))=$P(^AUPNPAT(P,83,A,0),U,V)
- .Q
- S C=$O(B(0))
- I C Q B(C)
- Q ""
- ;
- AUPNPCTR ; IHS/CMI/LAB - XREF TRIGGER FROM #1117 (RESIDENCE COMMUNITY PT) TO LAST PREVIOUS COMMUNITY 24-MAY-1993 ; [ 10/03/2007 8:57 AM ]
- +1 ;;99.1;IHS DICTIONARIES (PATIENT);**6,9,10,18,19**;JUN 13, 2003;Build 9
- S ;ENTRY POINT FOR SET TRIGGERS
- +1 SET DFN=DA(1)
- SET AUPN51DA=DA
- NEW (DFN,DT,DUZ,U,AUPN51DA)
- +2 DO LD
- IF AUPN5LD
- IF AUPN5LD=AUPN51DA
- +3 ; quit if date being edited is not the last date
- IF '$TEST
- GOTO END
- +4 DO SET
- GOTO END
- +5 ;-------------------------------------------------
- K ;ENTRY POINT FOR KILL TRIGGER
- +1 SET DFN=DA(1)
- SET AUPN51DA=DA
- NEW (DFN,DT,DUZ,U,AUPN51DA)
- +2 DO LD
- IF AUPN5LD
- IF AUPN5LD=AUPN51DA
- +3 ;exit if day being deleted is not the last date
- IF '$TEST
- GOTO END
- +4 ; find next to last date
- +5 SET (AUPN5,AUPN5NLD)=0
- IF ($DATA(^AUPNPAT(DFN,51))>1)
- FOR
- SET AUPN5=$ORDER(^AUPNPAT(DFN,51,AUPN5))
- IF 'AUPN5
- QUIT
- IF AUPN5=AUPN5LD
- QUIT
- SET AUPN5NLD=AUPN5
- +6 SET AUPN5LD=AUPN5NLD
- +7 DO SET
- GOTO END
- +8 ;
- +9 ;------------------------------------------------------------
- LD ; find last date
- +1 SET (AUPN5,AUPN5LD)=0
- +2 IF ($DATA(^AUPNPAT(DFN,51))>1)
- FOR
- SET AUPN5=$ORDER(^AUPNPAT(DFN,51,AUPN5))
- IF 'AUPN5
- QUIT
- SET AUPN5LD=AUPN5
- +3 QUIT
- +4 ;-------------------------------------------------
- SET ; Set Current Community , Current Residence PTR, Current Residence Date ; IHS/PAO/TMJ Fix of Subscript and DIE Call
- +1 IF AUPN5LD
- Begin DoDot:1
- +2 SET AUPNCC=$PIECE($GET(^AUPNPAT(DFN,51,AUPN5LD,0)),"^",3)
- +3 IF AUPNCC=""
- QUIT
- +4 ; pickup Current Community Pointer and name
- SET AUPNCCN=$PIECE($GET(^AUTTCOM(AUPNCC,0)),U)
- End DoDot:1
- IF AUPNCC>0
- IF AUPNCCN]""
- +5 IF '$TEST
- SET AUPNCC="@"
- SET AUPNCCN="@"
- +6 SET DIE="^AUPNPAT("
- SET DA=DFN
- SET DR="1118///"_AUPNCCN
- DO ^DIE
- +7 KILL AUPNTEMP("MFI",$JOB)
- SET DR="1117///"_$SELECT(AUPNCC="@":"",1:"`")_AUPNCC
- DO ^DIE
- KILL AUPNTEMP("MFI",$JOB)
- +8 SET Y="@"
- IF AUPN5LD
- SET Y=AUPN5LD
- DO DD^%DT
- +9 SET DR="1113///"_Y
- DO ^DIE
- KILL AUPNTEMP("MFI",$JOB)
- +10 QUIT
- +11 ;------------------------------------------------------------
- END ;
- EXIT ; all entry points NEW (DFN,DUZ,DT,U) and exit here
- +1 KILL AUPN51DA
- +2 QUIT
- +3 ;------------------------------------------------------------
- +4 ;------------------------------------------------------------
- MFI ;ENTRY POINT FOR MFI
- +1 ;IHS/OIT/LJF 02/28/2008 PATCH 19 skip if in Patient Merge
- IF $GET(XDRGID)
- QUIT
- +2 SET DFN=DA
- NEW (DFN,DT,DUZ,U,AUPN51DA,AUPNDOB,AUPNDOD,AUPNTEMP)
- +3 IF $DATA(AUPNTEMP("MFI",$JOB,DFN,1117))
- IF $DATA(AUPNTEMP("MFI",$JOB,DFN,1113))
- +4 ; wait for both fields to be set by MFI
- IF '$TEST
- QUIT
- +5 DO SETMFI
- KILL AUPNTEMP("MFI",$JOB,DFN)
- +6 DO LD
- DO SET
- +7 GOTO END
- +8 ;
- +9 ;--------------------------------------------------
- SETMFI ;
- +1 IF '$DATA(^AUPNPAT(DFN,51,0))
- SET ^AUPNPAT(DFN,51,0)="^9000001.51D^^"
- +2 SET AUPNCC=$PIECE(^AUPNPAT(DFN,11),U,17)
- SET AUPNDT=$PIECE(^AUPNPAT(DFN,11),U,13)
- +3 ; if node matches do not reset
- IF $DATA(^AUPNPAT(DFN,51,AUPNDT,0))
- IF $PIECE(^(0),U)=AUPNDT
- IF $PIECE(^(0),U,3)=AUPNCC
- QUIT
- +4 SET AUPNX=0
- FOR
- SET AUPNX=$ORDER(^AUPNPAT(DFN,51,AUPNX))
- IF 'AUPNX
- QUIT
- SET AUPNLPC=$PIECE(^AUPNPAT(DFN,51,AUPNX,0),U,3)
- SET AUPNX1=AUPNX
- +5 IF $DATA(AUPNLPC)
- IF AUPNLPC=AUPNCC
- DO DELCC
- +6 SET Y=AUPNDT
- DO DD^%DT
- SET X=Y
- SET DIC="^AUPNPAT("_DFN_",51,"
- SET DIC(0)="ML"
- SET DA(1)=DFN
- DO ^DIC
- KILL DIC,DR
- IF '+Y
- QUIT
- +7 SET DA=AUPNDT
- SET DA(1)=DFN
- SET DIE="^AUPNPAT("_DFN_",51,"
- SET DR=".03////"_AUPNCC
- +8 IF $PIECE(^AUPNPAT(DFN,51,DA,0),U,2)=""
- SET DR=DR_";.02////"_DT
- +9 DO ^DIE
- +10 QUIT
- +11 ;
- DELCC ; Delete Last Previous community multiple
- +1 SET DA(1)=DFN
- SET DA=AUPNX1
- SET DIK="^AUPNPAT("_DA(1)_",51,"
- +2 DO ^DIK
- KILL DA,DIK
- +3 QUIT
- +4 ;
- LASTEM(PAT) ;EP - called from trigger on previous email field
- +1 NEW A,B,C
- +2 KILL B
- +3 SET C=""
- +4 SET A=0
- FOR
- SET A=$ORDER(^AUPNPAT(PAT,82,A))
- IF A'=+A
- QUIT
- Begin DoDot:1
- +5 ;no date yet
- IF $PIECE(^AUPNPAT(PAT,82,A,0),U,1)=""
- QUIT
- +6 SET B(9999999-$PIECE(^AUPNPAT(PAT,82,A,0),U,1))=$PIECE(^AUPNPAT(PAT,82,A,0),U,2)
- +7 QUIT
- End DoDot:1
- +8 SET C=$ORDER(B(0))
- +9 IF C
- QUIT B(C)
- +10 QUIT ""
- +11 ;
- LASTADDR(P,V) ;EP - called to update .111 in file 2
- +1 NEW A,B,C
- +2 KILL B
- +3 SET A=0
- SET C=""
- FOR
- SET A=$ORDER(^AUPNPAT(P,83,A))
- IF A'=+A
- QUIT
- Begin DoDot:1
- +4 ;no date yet
- IF $PIECE(^AUPNPAT(P,83,A,0),U,1)=""
- QUIT
- +5 SET B(9999999-$PIECE(^AUPNPAT(P,83,A,0),U,1))=$PIECE(^AUPNPAT(P,83,A,0),U,V)
- +6 QUIT
- End DoDot:1
- +7 SET C=$ORDER(B(0))
- +8 IF C
- QUIT B(C)
- +9 QUIT ""
- +10 ;