Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMCHLB2

SCMCHLB2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. PTP ;Entry has been deleted from file 404.43. Send deletes to NPCD.
  1.  ;
  1.  NEW DFN,TP
  1.  D GETEVENT Q:'DFN  ;..Get DFN & TP from PCMM HL7 EVENT file
  1.  D PTPD(SCIEN) ;.......Send delete
  1.  ;alb/rpm;Patch 224 Decrement max msg counter
  1.  I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1
  1.  Q
  1.  ;
  1. PTPD(PTPI) ;From PCMM HL7 ID file, get all ID's whose 1st piece equals PTPI,
  1.  ;and send a delete segment.
  1.  ;Input: PTPI - 404.43 IEN (1st piece of ID)
  1.  ;
  1.  ;djb/bp Added SCSEQ per Patch 210[rel 204].
  1.  NEW DATA,ID,LINETAG,SCSEQ,VAFZPC
  1.  ;
  1.  S ID=PTPI_"-"
  1.  F  S ID=$O(^SCPT(404.49,"B",ID)) Q:ID=""!($P(ID,"-",1)'=PTPI)  D  ;
  1.  . N SUB  ; og/sd/524
  1.  . S SUB=PTPI,DATA="^^^" ;........A Delete type ZPC segment
  1.  . ;djb/bp Patch 210. Eliminate indirection[rel 204]
  1.  . D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA)
  1.  . D CPYZPC^SCMCHLS ;..Copy segment into array (needs ID & VAFZPC)
  1.  Q:'$D(@XMITARRY)
  1.  D SEGMENTS^SCMCHLB1(DFN,PTPI) ;Bld array of EVN,PID segments
  1.  Q
  1.  ;
  1. POS ;Entry has been deleted from file 404.52. Send deletes to NPCD.
  1.  ;
  1.  NEW DATA,DFN,ID,LINETAG,ND,POS,PTPI,VAFZPC
  1.  ;
  1.  ;From PCMM HL7 ID file, get all ID's whose 2nd piece equals SCIEN,
  1.  ;Build array sorted by:  DFN
  1.  ;                        404.43 IEN
  1.  ;                        ID
  1.  ;djb/bp Fix <STORE> errors for NOIS BIG-1199-71271.
  1.  ;       Replace local array POS() with global array.
  1.  S POS="^TMP(""PCMM"",""POS"","_$J_")"
  1.  KILL @POS
  1.  ;
  1.  S ID=""
  1.  F  S ID=$O(^SCPT(404.49,"B",ID)) Q:ID=""  D  ;
  1.  . Q:$P(ID,"-",2)'=SCIEN
  1.  . S PTPI=$P(ID,"-",1) ;...............404.43 IEN
  1.  . S ND=$G(^SCPT(404.43,PTPI,0))
  1.  . Q:($P(ND,U,5)'=1)  ;................Must be Primary Care
  1.  . S DFN=$$DFN^SCMCHLB1(ND) Q:'DFN  ;..Get patient
  1.  . ;
  1.  . S @POS@(DFN,PTPI,ID)="" ;djb/bp BIG-1199-71271
  1.  . ;
  1.  Q:'$D(@POS)
  1.  ;
  1.  ;Process array
  1.  S DFN=0
  1.  F  S DFN=$O(@POS@(DFN)) Q:'DFN  D  ;djb/bp BIG-1199-71271
  1.  . S PTPI=0
  1.  . F  S PTPI=$O(@POS@(DFN,PTPI)) Q:'PTPI  D  ;djb/bp BIG-1199-71271
  1.  .. NEW SCSEQ ;djb/bp Added per Patch 210.
  1.  .. ;alb/rpm;Patch 224 Decrement max msg counter
  1.  .. I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1
  1.  .. D SEGMENTS^SCMCHLB1(DFN,PTPI) ;Bld array of EVN,PID segments
  1.  .. S ID=""
  1.  .. F  S ID=$O(@POS@(DFN,PTPI,ID)) Q:ID=""  D  ;djb/bp BIG-1199-71271
  1.  ... N SUB  ; og/sd/524
  1.  ... S SUB=PTPI,DATA="^^^" ;........A Delete type ZPC segment
  1.  ... ;djb/bp Patch 210. Eliminate indirection[rel 204]
  1.  ... D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA)
  1.  ... D CPYZPC^SCMCHLS ;..Copy segment into array (needs ID & VAFZPC)
  1.  ;
  1.  KILL @POS ;djb/bp BIG-1199-71271
  1.  Q
  1.  ;
  1. PRE ;Entry has been deleted from file 404.53. Send deletes to NPCD.
  1.  ;****
  1.  ;Currently, deletes to 404.53 are not allowed if there are
  1.  ;patients assigned.
  1.  ;****
  1.  ;alb/rpm;Patch 224 Decrement max msg counter
  1.  ;Uncomment the following line if this tag becomes active
  1.  ;I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1
  1.  Q
  1.  ;
  1. GETEVENT ;Get data from PCMM HL7 EVENT file
  1.  ;Return: DFN - Patient IEN
  1.  ;        TP  - Team Position
  1.  ;
  1.  NEW IEN,ND,PTR
  1.  ;
  1.  ;If in manual mode, get SCEVIEN (404.48 IEN).
  1.  I $G(SCMANUAL) D  ;
  1.  . S (IEN,SCEVIEN)=0
  1.  . F  S IEN=$O(^SCPT(404.48,IEN)) Q:'IEN!SCEVIEN  D  ;
  1.  .. S PTR=$P($G(^(IEN,0)),U,7) Q:PTR=""
  1.  .. Q:PTR'=VARPTR
  1.  .. S SCEVIEN=IEN
  1.  ;
  1.  S ND=$G(^SCPT(404.48,SCEVIEN,0))
  1.  S DFN=$P(ND,U,2) ;..Patient (DFN)
  1.  S TP=$P(ND,U,4) ;...Team Position
  1.  Q