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

SCMCHLB1.m

Go to the documentation of this file.
  1. SCMCHLB1 ;BPOI/DJB - PCMM HL7 Bld Segment Array Cont.;8/17/99
  1. ;;5.3;Scheduling;**177,515,524**;08/17/99;Build 29
  1. ;
  1. SEGMENTS(DFN,SUB) ;Build EVN & PID segments
  1. ;Input:
  1. ; DFN - Patient IEN
  1. ; SUB - Value for 1st Subscript
  1. ;Output:
  1. ; XMITARRY() - Array of EVN & PID segments
  1. ;
  1. NEW LINETAG,SEGMENTS,SEGNAME,SEGORD
  1. NEW EVNTDATE,EVNTHL7,VAFARRY,VAFEVN,VAFPID,VAFSTR
  1. ;
  1. ;Initialize variables
  1. Q:'$G(DFN) ;Required for PID segment
  1. Q:'$G(SUB)
  1. S EVNTDATE=DT
  1. S EVNTHL7="A08"
  1. ;
  1. ;Get array of segments to be built
  1. D SEGMENTS^SCMCHLS(EVNTHL7,"SEGMENTS")
  1. ;
  1. ;Loop thru segments array. Ignore ZPC segment - already built.
  1. S SEGORD=0
  1. F S SEGORD=+$O(SEGMENTS(SEGORD)) Q:'SEGORD D ;
  1. . S SEGNAME=""
  1. . F S SEGNAME=$O(SEGMENTS(SEGORD,SEGNAME)) Q:SEGNAME="" D ;
  1. .. Q:SEGNAME="ZPC" ;.................ZPC already built
  1. .. S VAFSTR=SEGMENTS(SEGORD,SEGNAME) ;String of segment fields
  1. .. S LINETAG="BLD"_SEGNAME
  1. .. D @LINETAG^SCMCHLS ;...............Build segment
  1. .. S LINETAG="CPY"_SEGNAME
  1. .. D @LINETAG^SCMCHLS ;...............Copy segment into array
  1. Q
  1. ;
  1. ZPC(ARRAY,DELETE) ;Loop thru array and build array of ZPC segments.
  1. ;
  1. ;Input:
  1. ; ARRAY - Array to be processed. This array was built in ^SCMCHLB
  1. ; with calls to $$PRTPC^SCAPMC() and $$PRPTTPC^SCAPMC().
  1. ; Examples:
  1. ; ARRAY(2290,"PCP","2290-406-34-PCP")= Data
  1. ; ARRAY(345,"PROV-P","2290-405-0-AP")= Data
  1. ; DELETE - 1=Process a delete type ZPC segment (all fields null)
  1. ;Output:
  1. ; Array of ZPC segments
  1. ;
  1. NEW DATA,DATE,ID,ID1,LINETAG,SUB,TYPE,VAFZPC
  1. ;
  1. S SUB=0
  1. F S SUB=$O(ARRAY(SUB)) Q:'SUB D ;
  1. . S TYPE=""
  1. . F S TYPE=$O(ARRAY(SUB,TYPE)) Q:TYPE="" D ;
  1. .. S ID=""
  1. .. F S ID=$O(ARRAY(SUB,TYPE,ID)) Q:ID="" D ;
  1. ... S DATA=$G(ARRAY(SUB,TYPE,ID))
  1. ... I $G(DELETE) S DATA="^^^" ;A Delete type ZPC segment
  1. ... E D ;....................A ZPC segment with data
  1. .... ;Get dates
  1. .... S DATE(9)=$P(DATA,U,9)
  1. .... S DATE(10)=$P(DATA,U,10)
  1. .... S DATE(14)=$P(DATA,U,14) ;Preceptor start date
  1. .... S DATE(15)=$P(DATA,U,15) ;Preceptor end date
  1. .... I DATE(14),DATE(14)>DATE(9) S DATE(9)=DATE(14)
  1. .... I DATE(15) D ;
  1. ..... I 'DATE(10) S DATE(10)=DATE(15) Q
  1. ..... I DATE(15)<DATE(10) S DATE(10)=DATE(15)
  1. .... ;
  1. .... ;Provider^AssignDate^UnassignDate^ProviderType
  1. .... S DATA=$P(DATA,U,1)_"^"_DATE(9)_"^"_DATE(10)
  1. ....; PATCH 515 DLL ADD NEW ROLES (TPA,CCM,PM)
  1. ....; OLD CODE = S DATA=DATA_"^"_$S(ID["AP":"AP",1:"PCP")
  1. ....S ROLE=$P(ID,"-",4) I $G(ROLE)="" S ROLE="PCP"
  1. ....S DATA=DATA_"^"_ROLE
  1. ... ;
  1. ... D BLDZPC^SCMCHLS ;..Build segment ; og/sd/524
  1. ... D CPYZPC^SCMCHLS ;..Copy segment into array ; og/sd/524
  1. Q
  1. ;
  1. DFN(ND) ;Find DFN from zero node of Patient Team Position Assign (404.43).
  1. ;Input:
  1. ; ND - Zero node of 404.43
  1. ;Output:
  1. ; DFN - Patient IEN
  1. ; "" - No valid DFN found
  1. ;
  1. S DFN=$P(ND,U,1)
  1. I DFN S DFN=$P($G(^SCPT(404.42,DFN,0)),U,1)
  1. Q DFN
  1. ;
  1. ADJID(ARRAY,SCIEN) ;Adjust ID to include Pt Tm Pos Assign pointer
  1. ;Example: From this: 424-34-AP
  1. ; To this: 2290-424-34-AP
  1. ;Input:
  1. ; ARRAY - Array to be processed
  1. ; SCIEN - 404.43 IEN to be added to ID
  1. ;
  1. NEW ADJID,ID,NUM,TMP,TYPE
  1. ;
  1. ;Build TMP() array using adjusted ID
  1. S NUM=0
  1. F S NUM=$O(ARRAY(NUM)) Q:'NUM D ;
  1. . S TYPE=""
  1. . F S TYPE=$O(ARRAY(NUM,TYPE)) Q:TYPE="" D ;
  1. .. S ID=""
  1. .. F S ID=$O(ARRAY(NUM,TYPE,ID)) Q:ID="" D ;
  1. ... S ADJID=SCIEN_"-"_ID ;..Add 404.43 IEN
  1. ... S TMP(NUM,TYPE,ADJID)=ARRAY(NUM,TYPE,ID)
  1. ;
  1. ;Replace ARRAY() with adjusted TMP() array.
  1. Q:'$D(TMP)
  1. KILL ARRAY
  1. M ARRAY=TMP ;Copy TMP() into ARRAY()
  1. Q
  1. ;
  1. CHECK(VARPTR) ;Validate event variable pointer.
  1. ;Input:
  1. ; VARPTR - EVENT POINTER field of PCMM HL7 EVENT (#404.48)
  1. ;Output:
  1. ; SCIEN - IEN portion of variable pointer
  1. ; SCGLB - Global portion of variable pointer
  1. ;Return:
  1. ; 0: Invalid variable pointer format
  1. ; 1: Valid pointer
  1. ; 2: No data. Entry has been deleted. Send a delete to NPCD.
  1. ;
  1. NEW CHK,GLB
  1. ;
  1. S SCIEN=$P(VARPTR,";") ;....IEN portion of variable pointer
  1. S SCGLB=$P(VARPTR,";",2) ;..Global portion of variable pointer
  1. ;
  1. ;Return zero if variable pointer is invalid.
  1. I 'SCIEN Q 0
  1. S CHK=0 D I CHK Q 0
  1. . Q:SCGLB="SCPT(404.43,"
  1. . Q:SCGLB="SCTM(404.52,"
  1. . Q:SCGLB="SCTM(404.53,"
  1. . S CHK=1
  1. ;
  1. ;Is there data for this IEN?
  1. S GLB="^"_SCGLB_SCIEN_",0)"
  1. I '$D(@GLB) Q 2 ;..Entry has been deleted
  1. Q 1