SCMCHLB2 ;BPOI/DJB - PCMM HL7 Bld Segment Array Deletes;3/6/00
;;5.3;Scheduling;**177,204,210,224,524**;08/13/93;Build 29
;
PTP ;Entry has been deleted from file 404.43. Send deletes to NPCD.
;
NEW DFN,TP
D GETEVENT Q:'DFN ;..Get DFN & TP from PCMM HL7 EVENT file
D PTPD(SCIEN) ;.......Send delete
;alb/rpm;Patch 224 Decrement max msg counter
I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1
Q
;
PTPD(PTPI) ;From PCMM HL7 ID file, get all ID's whose 1st piece equals PTPI,
;and send a delete segment.
;Input: PTPI - 404.43 IEN (1st piece of ID)
;
;djb/bp Added SCSEQ per Patch 210[rel 204].
NEW DATA,ID,LINETAG,SCSEQ,VAFZPC
;
S ID=PTPI_"-"
F S ID=$O(^SCPT(404.49,"B",ID)) Q:ID=""!($P(ID,"-",1)'=PTPI) D ;
. N SUB ; og/sd/524
. S SUB=PTPI,DATA="^^^" ;........A Delete type ZPC segment
. ;djb/bp Patch 210. Eliminate indirection[rel 204]
. D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA)
. D CPYZPC^SCMCHLS ;..Copy segment into array (needs ID & VAFZPC)
Q:'$D(@XMITARRY)
D SEGMENTS^SCMCHLB1(DFN,PTPI) ;Bld array of EVN,PID segments
Q
;
POS ;Entry has been deleted from file 404.52. Send deletes to NPCD.
;
NEW DATA,DFN,ID,LINETAG,ND,POS,PTPI,VAFZPC
;
;From PCMM HL7 ID file, get all ID's whose 2nd piece equals SCIEN,
;Build array sorted by: DFN
; 404.43 IEN
; ID
;djb/bp Fix <STORE> errors for NOIS BIG-1199-71271.
; Replace local array POS() with global array.
S POS="^TMP(""PCMM"",""POS"","_$J_")"
KILL @POS
;
S ID=""
F S ID=$O(^SCPT(404.49,"B",ID)) Q:ID="" D ;
. Q:$P(ID,"-",2)'=SCIEN
. S PTPI=$P(ID,"-",1) ;...............404.43 IEN
. S ND=$G(^SCPT(404.43,PTPI,0))
. Q:($P(ND,U,5)'=1) ;................Must be Primary Care
. S DFN=$$DFN^SCMCHLB1(ND) Q:'DFN ;..Get patient
. ;
. S @POS@(DFN,PTPI,ID)="" ;djb/bp BIG-1199-71271
. ;
Q:'$D(@POS)
;
;Process array
S DFN=0
F S DFN=$O(@POS@(DFN)) Q:'DFN D ;djb/bp BIG-1199-71271
. S PTPI=0
. F S PTPI=$O(@POS@(DFN,PTPI)) Q:'PTPI D ;djb/bp BIG-1199-71271
.. NEW SCSEQ ;djb/bp Added per Patch 210.
.. ;alb/rpm;Patch 224 Decrement max msg counter
.. I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1
.. D SEGMENTS^SCMCHLB1(DFN,PTPI) ;Bld array of EVN,PID segments
.. S ID=""
.. F S ID=$O(@POS@(DFN,PTPI,ID)) Q:ID="" D ;djb/bp BIG-1199-71271
... N SUB ; og/sd/524
... S SUB=PTPI,DATA="^^^" ;........A Delete type ZPC segment
... ;djb/bp Patch 210. Eliminate indirection[rel 204]
... D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA)
... D CPYZPC^SCMCHLS ;..Copy segment into array (needs ID & VAFZPC)
;
KILL @POS ;djb/bp BIG-1199-71271
Q
;
PRE ;Entry has been deleted from file 404.53. Send deletes to NPCD.
;****
;Currently, deletes to 404.53 are not allowed if there are
;patients assigned.
;****
;alb/rpm;Patch 224 Decrement max msg counter
;Uncomment the following line if this tag becomes active
;I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1
Q
;
GETEVENT ;Get data from PCMM HL7 EVENT file
;Return: DFN - Patient IEN
; TP - Team Position
;
NEW IEN,ND,PTR
;
;If in manual mode, get SCEVIEN (404.48 IEN).
I $G(SCMANUAL) D ;
. S (IEN,SCEVIEN)=0
. F S IEN=$O(^SCPT(404.48,IEN)) Q:'IEN!SCEVIEN D ;
.. S PTR=$P($G(^(IEN,0)),U,7) Q:PTR=""
.. Q:PTR'=VARPTR
.. S SCEVIEN=IEN
;
S ND=$G(^SCPT(404.48,SCEVIEN,0))
S DFN=$P(ND,U,2) ;..Patient (DFN)
S TP=$P(ND,U,4) ;...Team Position
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCHLB2 3466 printed Apr 09, 2024@22:01:45 Page 2
SCMCHLB2 ;BPOI/DJB - PCMM HL7 Bld Segment Array Deletes;3/6/00
+1 ;;5.3;Scheduling;**177,204,210,224,524**;08/13/93;Build 29
+2 ;
PTP ;Entry has been deleted from file 404.43. Send deletes to NPCD.
+1 ;
+2 NEW DFN,TP
+3 ;..Get DFN & TP from PCMM HL7 EVENT file
DO GETEVENT
if 'DFN
QUIT
+4 ;.......Send delete
DO PTPD(SCIEN)
+5 ;alb/rpm;Patch 224 Decrement max msg counter
+6 IF $DATA(SCLIMIT)
SET SCLIMIT=SCLIMIT-1
+7 QUIT
+8 ;
PTPD(PTPI) ;From PCMM HL7 ID file, get all ID's whose 1st piece equals PTPI,
+1 ;and send a delete segment.
+2 ;Input: PTPI - 404.43 IEN (1st piece of ID)
+3 ;
+4 ;djb/bp Added SCSEQ per Patch 210[rel 204].
+5 NEW DATA,ID,LINETAG,SCSEQ,VAFZPC
+6 ;
+7 SET ID=PTPI_"-"
+8 ;
FOR
SET ID=$ORDER(^SCPT(404.49,"B",ID))
if ID=""!($PIECE(ID,"-",1)'=PTPI)
QUIT
Begin DoDot:1
+9 ; og/sd/524
NEW SUB
+10 ;........A Delete type ZPC segment
SET SUB=PTPI
SET DATA="^^^"
+11 ;djb/bp Patch 210. Eliminate indirection[rel 204]
+12 ;..Build segment (needs ID & DATA)
DO BLDZPC^SCMCHLS
+13 ;..Copy segment into array (needs ID & VAFZPC)
DO CPYZPC^SCMCHLS
End DoDot:1
+14 if '$DATA(@XMITARRY)
QUIT
+15 ;Bld array of EVN,PID segments
DO SEGMENTS^SCMCHLB1(DFN,PTPI)
+16 QUIT
+17 ;
POS ;Entry has been deleted from file 404.52. Send deletes to NPCD.
+1 ;
+2 NEW DATA,DFN,ID,LINETAG,ND,POS,PTPI,VAFZPC
+3 ;
+4 ;From PCMM HL7 ID file, get all ID's whose 2nd piece equals SCIEN,
+5 ;Build array sorted by: DFN
+6 ; 404.43 IEN
+7 ; ID
+8 ;djb/bp Fix <STORE> errors for NOIS BIG-1199-71271.
+9 ; Replace local array POS() with global array.
+10 SET POS="^TMP(""PCMM"",""POS"","_$JOB_")"
+11 KILL @POS
+12 ;
+13 SET ID=""
+14 ;
FOR
SET ID=$ORDER(^SCPT(404.49,"B",ID))
if ID=""
QUIT
Begin DoDot:1
+15 if $PIECE(ID,"-",2)'=SCIEN
QUIT
+16 ;...............404.43 IEN
SET PTPI=$PIECE(ID,"-",1)
+17 SET ND=$GET(^SCPT(404.43,PTPI,0))
+18 ;................Must be Primary Care
if ($PIECE(ND,U,5)'=1)
QUIT
+19 ;..Get patient
SET DFN=$$DFN^SCMCHLB1(ND)
if 'DFN
QUIT
+20 ;
+21 ;djb/bp BIG-1199-71271
SET @POS@(DFN,PTPI,ID)=""
+22 ;
End DoDot:1
+23 if '$DATA(@POS)
QUIT
+24 ;
+25 ;Process array
+26 SET DFN=0
+27 ;djb/bp BIG-1199-71271
FOR
SET DFN=$ORDER(@POS@(DFN))
if 'DFN
QUIT
Begin DoDot:1
+28 SET PTPI=0
+29 ;djb/bp BIG-1199-71271
FOR
SET PTPI=$ORDER(@POS@(DFN,PTPI))
if 'PTPI
QUIT
Begin DoDot:2
+30 ;djb/bp Added per Patch 210.
NEW SCSEQ
+31 ;alb/rpm;Patch 224 Decrement max msg counter
+32 IF $DATA(SCLIMIT)
SET SCLIMIT=SCLIMIT-1
+33 ;Bld array of EVN,PID segments
DO SEGMENTS^SCMCHLB1(DFN,PTPI)
+34 SET ID=""
+35 ;djb/bp BIG-1199-71271
FOR
SET ID=$ORDER(@POS@(DFN,PTPI,ID))
if ID=""
QUIT
Begin DoDot:3
+36 ; og/sd/524
NEW SUB
+37 ;........A Delete type ZPC segment
SET SUB=PTPI
SET DATA="^^^"
+38 ;djb/bp Patch 210. Eliminate indirection[rel 204]
+39 ;..Build segment (needs ID & DATA)
DO BLDZPC^SCMCHLS
+40 ;..Copy segment into array (needs ID & VAFZPC)
DO CPYZPC^SCMCHLS
End DoDot:3
End DoDot:2
End DoDot:1
+41 ;
+42 ;djb/bp BIG-1199-71271
KILL @POS
+43 QUIT
+44 ;
PRE ;Entry has been deleted from file 404.53. Send deletes to NPCD.
+1 ;****
+2 ;Currently, deletes to 404.53 are not allowed if there are
+3 ;patients assigned.
+4 ;****
+5 ;alb/rpm;Patch 224 Decrement max msg counter
+6 ;Uncomment the following line if this tag becomes active
+7 ;I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1
+8 QUIT
+9 ;
GETEVENT ;Get data from PCMM HL7 EVENT file
+1 ;Return: DFN - Patient IEN
+2 ; TP - Team Position
+3 ;
+4 NEW IEN,ND,PTR
+5 ;
+6 ;If in manual mode, get SCEVIEN (404.48 IEN).
+7 ;
IF $GET(SCMANUAL)
Begin DoDot:1
+8 SET (IEN,SCEVIEN)=0
+9 ;
FOR
SET IEN=$ORDER(^SCPT(404.48,IEN))
if 'IEN!SCEVIEN
QUIT
Begin DoDot:2
+10 SET PTR=$PIECE($GET(^(IEN,0)),U,7)
if PTR=""
QUIT
+11 if PTR'=VARPTR
QUIT
+12 SET SCEVIEN=IEN
End DoDot:2
End DoDot:1
+13 ;
+14 SET ND=$GET(^SCPT(404.48,SCEVIEN,0))
+15 ;..Patient (DFN)
SET DFN=$PIECE(ND,U,2)
+16 ;...Team Position
SET TP=$PIECE(ND,U,4)
+17 QUIT
