- SCMCHLB1 ;BPOI/DJB - PCMM HL7 Bld Segment Array Cont.;8/17/99
- ;;5.3;Scheduling;**177,515,524**;08/17/99;Build 29
- ;
- SEGMENTS(DFN,SUB) ;Build EVN & PID segments
- ;Input:
- ; DFN - Patient IEN
- ; SUB - Value for 1st Subscript
- ;Output:
- ; XMITARRY() - Array of EVN & PID segments
- ;
- NEW LINETAG,SEGMENTS,SEGNAME,SEGORD
- NEW EVNTDATE,EVNTHL7,VAFARRY,VAFEVN,VAFPID,VAFSTR
- ;
- ;Initialize variables
- Q:'$G(DFN) ;Required for PID segment
- Q:'$G(SUB)
- S EVNTDATE=DT
- S EVNTHL7="A08"
- ;
- ;Get array of segments to be built
- D SEGMENTS^SCMCHLS(EVNTHL7,"SEGMENTS")
- ;
- ;Loop thru segments array. Ignore ZPC segment - already built.
- S SEGORD=0
- F S SEGORD=+$O(SEGMENTS(SEGORD)) Q:'SEGORD D ;
- . S SEGNAME=""
- . F S SEGNAME=$O(SEGMENTS(SEGORD,SEGNAME)) Q:SEGNAME="" D ;
- .. Q:SEGNAME="ZPC" ;.................ZPC already built
- .. S VAFSTR=SEGMENTS(SEGORD,SEGNAME) ;String of segment fields
- .. S LINETAG="BLD"_SEGNAME
- .. D @LINETAG^SCMCHLS ;...............Build segment
- .. S LINETAG="CPY"_SEGNAME
- .. D @LINETAG^SCMCHLS ;...............Copy segment into array
- Q
- ;
- ZPC(ARRAY,DELETE) ;Loop thru array and build array of ZPC segments.
- ;
- ;Input:
- ; ARRAY - Array to be processed. This array was built in ^SCMCHLB
- ; with calls to $$PRTPC^SCAPMC() and $$PRPTTPC^SCAPMC().
- ; Examples:
- ; ARRAY(2290,"PCP","2290-406-34-PCP")= Data
- ; ARRAY(345,"PROV-P","2290-405-0-AP")= Data
- ; DELETE - 1=Process a delete type ZPC segment (all fields null)
- ;Output:
- ; Array of ZPC segments
- ;
- NEW DATA,DATE,ID,ID1,LINETAG,SUB,TYPE,VAFZPC
- ;
- S SUB=0
- F S SUB=$O(ARRAY(SUB)) Q:'SUB D ;
- . S TYPE=""
- . F S TYPE=$O(ARRAY(SUB,TYPE)) Q:TYPE="" D ;
- .. S ID=""
- .. F S ID=$O(ARRAY(SUB,TYPE,ID)) Q:ID="" D ;
- ... S DATA=$G(ARRAY(SUB,TYPE,ID))
- ... I $G(DELETE) S DATA="^^^" ;A Delete type ZPC segment
- ... E D ;....................A ZPC segment with data
- .... ;Get dates
- .... S DATE(9)=$P(DATA,U,9)
- .... S DATE(10)=$P(DATA,U,10)
- .... S DATE(14)=$P(DATA,U,14) ;Preceptor start date
- .... S DATE(15)=$P(DATA,U,15) ;Preceptor end date
- .... I DATE(14),DATE(14)>DATE(9) S DATE(9)=DATE(14)
- .... I DATE(15) D ;
- ..... I 'DATE(10) S DATE(10)=DATE(15) Q
- ..... I DATE(15)<DATE(10) S DATE(10)=DATE(15)
- .... ;
- .... ;Provider^AssignDate^UnassignDate^ProviderType
- .... S DATA=$P(DATA,U,1)_"^"_DATE(9)_"^"_DATE(10)
- ....; PATCH 515 DLL ADD NEW ROLES (TPA,CCM,PM)
- ....; OLD CODE = S DATA=DATA_"^"_$S(ID["AP":"AP",1:"PCP")
- ....S ROLE=$P(ID,"-",4) I $G(ROLE)="" S ROLE="PCP"
- ....S DATA=DATA_"^"_ROLE
- ... ;
- ... D BLDZPC^SCMCHLS ;..Build segment ; og/sd/524
- ... D CPYZPC^SCMCHLS ;..Copy segment into array ; og/sd/524
- Q
- ;
- DFN(ND) ;Find DFN from zero node of Patient Team Position Assign (404.43).
- ;Input:
- ; ND - Zero node of 404.43
- ;Output:
- ; DFN - Patient IEN
- ; "" - No valid DFN found
- ;
- S DFN=$P(ND,U,1)
- I DFN S DFN=$P($G(^SCPT(404.42,DFN,0)),U,1)
- Q DFN
- ;
- ADJID(ARRAY,SCIEN) ;Adjust ID to include Pt Tm Pos Assign pointer
- ;Example: From this: 424-34-AP
- ; To this: 2290-424-34-AP
- ;Input:
- ; ARRAY - Array to be processed
- ; SCIEN - 404.43 IEN to be added to ID
- ;
- NEW ADJID,ID,NUM,TMP,TYPE
- ;
- ;Build TMP() array using adjusted ID
- S NUM=0
- F S NUM=$O(ARRAY(NUM)) Q:'NUM D ;
- . S TYPE=""
- . F S TYPE=$O(ARRAY(NUM,TYPE)) Q:TYPE="" D ;
- .. S ID=""
- .. F S ID=$O(ARRAY(NUM,TYPE,ID)) Q:ID="" D ;
- ... S ADJID=SCIEN_"-"_ID ;..Add 404.43 IEN
- ... S TMP(NUM,TYPE,ADJID)=ARRAY(NUM,TYPE,ID)
- ;
- ;Replace ARRAY() with adjusted TMP() array.
- Q:'$D(TMP)
- KILL ARRAY
- M ARRAY=TMP ;Copy TMP() into ARRAY()
- Q
- ;
- CHECK(VARPTR) ;Validate event variable pointer.
- ;Input:
- ; VARPTR - EVENT POINTER field of PCMM HL7 EVENT (#404.48)
- ;Output:
- ; SCIEN - IEN portion of variable pointer
- ; SCGLB - Global portion of variable pointer
- ;Return:
- ; 0: Invalid variable pointer format
- ; 1: Valid pointer
- ; 2: No data. Entry has been deleted. Send a delete to NPCD.
- ;
- NEW CHK,GLB
- ;
- S SCIEN=$P(VARPTR,";") ;....IEN portion of variable pointer
- S SCGLB=$P(VARPTR,";",2) ;..Global portion of variable pointer
- ;
- ;Return zero if variable pointer is invalid.
- I 'SCIEN Q 0
- S CHK=0 D I CHK Q 0
- . Q:SCGLB="SCPT(404.43,"
- . Q:SCGLB="SCTM(404.52,"
- . Q:SCGLB="SCTM(404.53,"
- . S CHK=1
- ;
- ;Is there data for this IEN?
- S GLB="^"_SCGLB_SCIEN_",0)"
- I '$D(@GLB) Q 2 ;..Entry has been deleted
- Q 1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCHLB1 4567 printed Dec 13, 2024@02:40:25 Page 2
- SCMCHLB1 ;BPOI/DJB - PCMM HL7 Bld Segment Array Cont.;8/17/99
- +1 ;;5.3;Scheduling;**177,515,524**;08/17/99;Build 29
- +2 ;
- SEGMENTS(DFN,SUB) ;Build EVN & PID segments
- +1 ;Input:
- +2 ; DFN - Patient IEN
- +3 ; SUB - Value for 1st Subscript
- +4 ;Output:
- +5 ; XMITARRY() - Array of EVN & PID segments
- +6 ;
- +7 NEW LINETAG,SEGMENTS,SEGNAME,SEGORD
- +8 NEW EVNTDATE,EVNTHL7,VAFARRY,VAFEVN,VAFPID,VAFSTR
- +9 ;
- +10 ;Initialize variables
- +11 ;Required for PID segment
- if '$GET(DFN)
- QUIT
- +12 if '$GET(SUB)
- QUIT
- +13 SET EVNTDATE=DT
- +14 SET EVNTHL7="A08"
- +15 ;
- +16 ;Get array of segments to be built
- +17 DO SEGMENTS^SCMCHLS(EVNTHL7,"SEGMENTS")
- +18 ;
- +19 ;Loop thru segments array. Ignore ZPC segment - already built.
- +20 SET SEGORD=0
- +21 ;
- FOR
- SET SEGORD=+$ORDER(SEGMENTS(SEGORD))
- if 'SEGORD
- QUIT
- Begin DoDot:1
- +22 SET SEGNAME=""
- +23 ;
- FOR
- SET SEGNAME=$ORDER(SEGMENTS(SEGORD,SEGNAME))
- if SEGNAME=""
- QUIT
- Begin DoDot:2
- +24 ;.................ZPC already built
- if SEGNAME="ZPC"
- QUIT
- +25 ;String of segment fields
- SET VAFSTR=SEGMENTS(SEGORD,SEGNAME)
- +26 SET LINETAG="BLD"_SEGNAME
- +27 ;...............Build segment
- DO @LINETAG^SCMCHLS
- +28 SET LINETAG="CPY"_SEGNAME
- +29 ;...............Copy segment into array
- DO @LINETAG^SCMCHLS
- End DoDot:2
- End DoDot:1
- +30 QUIT
- +31 ;
- ZPC(ARRAY,DELETE) ;Loop thru array and build array of ZPC segments.
- +1 ;
- +2 ;Input:
- +3 ; ARRAY - Array to be processed. This array was built in ^SCMCHLB
- +4 ; with calls to $$PRTPC^SCAPMC() and $$PRPTTPC^SCAPMC().
- +5 ; Examples:
- +6 ; ARRAY(2290,"PCP","2290-406-34-PCP")= Data
- +7 ; ARRAY(345,"PROV-P","2290-405-0-AP")= Data
- +8 ; DELETE - 1=Process a delete type ZPC segment (all fields null)
- +9 ;Output:
- +10 ; Array of ZPC segments
- +11 ;
- +12 NEW DATA,DATE,ID,ID1,LINETAG,SUB,TYPE,VAFZPC
- +13 ;
- +14 SET SUB=0
- +15 ;
- FOR
- SET SUB=$ORDER(ARRAY(SUB))
- if 'SUB
- QUIT
- Begin DoDot:1
- +16 SET TYPE=""
- +17 ;
- FOR
- SET TYPE=$ORDER(ARRAY(SUB,TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:2
- +18 SET ID=""
- +19 ;
- FOR
- SET ID=$ORDER(ARRAY(SUB,TYPE,ID))
- if ID=""
- QUIT
- Begin DoDot:3
- +20 SET DATA=$GET(ARRAY(SUB,TYPE,ID))
- +21 ;A Delete type ZPC segment
- IF $GET(DELETE)
- SET DATA="^^^"
- +22 ;....................A ZPC segment with data
- IF '$TEST
- Begin DoDot:4
- +23 ;Get dates
- +24 SET DATE(9)=$PIECE(DATA,U,9)
- +25 SET DATE(10)=$PIECE(DATA,U,10)
- +26 ;Preceptor start date
- SET DATE(14)=$PIECE(DATA,U,14)
- +27 ;Preceptor end date
- SET DATE(15)=$PIECE(DATA,U,15)
- +28 IF DATE(14)
- IF DATE(14)>DATE(9)
- SET DATE(9)=DATE(14)
- +29 ;
- IF DATE(15)
- Begin DoDot:5
- +30 IF 'DATE(10)
- SET DATE(10)=DATE(15)
- QUIT
- +31 IF DATE(15)<DATE(10)
- SET DATE(10)=DATE(15)
- End DoDot:5
- +32 ;
- +33 ;Provider^AssignDate^UnassignDate^ProviderType
- +34 SET DATA=$PIECE(DATA,U,1)_"^"_DATE(9)_"^"_DATE(10)
- +35 ; PATCH 515 DLL ADD NEW ROLES (TPA,CCM,PM)
- +36 ; OLD CODE = S DATA=DATA_"^"_$S(ID["AP":"AP",1:"PCP")
- +37 SET ROLE=$PIECE(ID,"-",4)
- IF $GET(ROLE)=""
- SET ROLE="PCP"
- +38 SET DATA=DATA_"^"_ROLE
- End DoDot:4
- +39 ;
- +40 ;..Build segment ; og/sd/524
- DO BLDZPC^SCMCHLS
- +41 ;..Copy segment into array ; og/sd/524
- DO CPYZPC^SCMCHLS
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +42 QUIT
- +43 ;
- DFN(ND) ;Find DFN from zero node of Patient Team Position Assign (404.43).
- +1 ;Input:
- +2 ; ND - Zero node of 404.43
- +3 ;Output:
- +4 ; DFN - Patient IEN
- +5 ; "" - No valid DFN found
- +6 ;
- +7 SET DFN=$PIECE(ND,U,1)
- +8 IF DFN
- SET DFN=$PIECE($GET(^SCPT(404.42,DFN,0)),U,1)
- +9 QUIT DFN
- +10 ;
- ADJID(ARRAY,SCIEN) ;Adjust ID to include Pt Tm Pos Assign pointer
- +1 ;Example: From this: 424-34-AP
- +2 ; To this: 2290-424-34-AP
- +3 ;Input:
- +4 ; ARRAY - Array to be processed
- +5 ; SCIEN - 404.43 IEN to be added to ID
- +6 ;
- +7 NEW ADJID,ID,NUM,TMP,TYPE
- +8 ;
- +9 ;Build TMP() array using adjusted ID
- +10 SET NUM=0
- +11 ;
- FOR
- SET NUM=$ORDER(ARRAY(NUM))
- if 'NUM
- QUIT
- Begin DoDot:1
- +12 SET TYPE=""
- +13 ;
- FOR
- SET TYPE=$ORDER(ARRAY(NUM,TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:2
- +14 SET ID=""
- +15 ;
- FOR
- SET ID=$ORDER(ARRAY(NUM,TYPE,ID))
- if ID=""
- QUIT
- Begin DoDot:3
- +16 ;..Add 404.43 IEN
- SET ADJID=SCIEN_"-"_ID
- +17 SET TMP(NUM,TYPE,ADJID)=ARRAY(NUM,TYPE,ID)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +18 ;
- +19 ;Replace ARRAY() with adjusted TMP() array.
- +20 if '$DATA(TMP)
- QUIT
- +21 KILL ARRAY
- +22 ;Copy TMP() into ARRAY()
- MERGE ARRAY=TMP
- +23 QUIT
- +24 ;
- CHECK(VARPTR) ;Validate event variable pointer.
- +1 ;Input:
- +2 ; VARPTR - EVENT POINTER field of PCMM HL7 EVENT (#404.48)
- +3 ;Output:
- +4 ; SCIEN - IEN portion of variable pointer
- +5 ; SCGLB - Global portion of variable pointer
- +6 ;Return:
- +7 ; 0: Invalid variable pointer format
- +8 ; 1: Valid pointer
- +9 ; 2: No data. Entry has been deleted. Send a delete to NPCD.
- +10 ;
- +11 NEW CHK,GLB
- +12 ;
- +13 ;....IEN portion of variable pointer
- SET SCIEN=$PIECE(VARPTR,";")
- +14 ;..Global portion of variable pointer
- SET SCGLB=$PIECE(VARPTR,";",2)
- +15 ;
- +16 ;Return zero if variable pointer is invalid.
- +17 IF 'SCIEN
- QUIT 0
- +18 SET CHK=0
- Begin DoDot:1
- +19 if SCGLB="SCPT(404.43,"
- QUIT
- +20 if SCGLB="SCTM(404.52,"
- QUIT
- +21 if SCGLB="SCTM(404.53,"
- QUIT
- +22 SET CHK=1
- End DoDot:1
- IF CHK
- QUIT 0
- +23 ;
- +24 ;Is there data for this IEN?
- +25 SET GLB="^"_SCGLB_SCIEN_",0)"
- +26 ;..Entry has been deleted
- IF '$DATA(@GLB)
- QUIT 2
- +27 QUIT 1