Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCHLB1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCHLB1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCHLB1.m
r613 r623 1 SCMCHLB1 ;BPOI/DJB - PCMM HL7 Bld Segment Array Cont.;8/17/99 2 ;;5.3;Scheduling;**177,515,524**;08/17/99;Build 29 3 ; 4 SEGMENTS(DFN,SUB) ;Build EVN & PID segments 5 ;Input: 6 ; DFN - Patient IEN 7 ; SUB - Value for 1st Subscript 8 ;Output: 9 ; XMITARRY() - Array of EVN & PID segments 10 ; 11 NEW LINETAG,SEGMENTS,SEGNAME,SEGORD 12 NEW EVNTDATE,EVNTHL7,VAFARRY,VAFEVN,VAFPID,VAFSTR 13 ; 14 ;Initialize variables 15 Q:'$G(DFN) ;Required for PID segment 16 Q:'$G(SUB) 17 S EVNTDATE=DT 18 S EVNTHL7="A08" 19 ; 20 ;Get array of segments to be built 21 D SEGMENTS^SCMCHLS(EVNTHL7,"SEGMENTS") 22 ; 23 ;Loop thru segments array. Ignore ZPC segment - already built. 24 S SEGORD=0 25 F S SEGORD=+$O(SEGMENTS(SEGORD)) Q:'SEGORD D ; 26 . S SEGNAME="" 27 . F S SEGNAME=$O(SEGMENTS(SEGORD,SEGNAME)) Q:SEGNAME="" D ; 28 .. Q:SEGNAME="ZPC" ;.................ZPC already built 29 .. S VAFSTR=SEGMENTS(SEGORD,SEGNAME) ;String of segment fields 30 .. S LINETAG="BLD"_SEGNAME 31 .. D @LINETAG^SCMCHLS ;...............Build segment 32 .. S LINETAG="CPY"_SEGNAME 33 .. D @LINETAG^SCMCHLS ;...............Copy segment into array 34 Q 35 ; 36 ZPC(ARRAY,DELETE) ;Loop thru array and build array of ZPC segments. 37 ; 38 ;Input: 39 ; ARRAY - Array to be processed. This array was built in ^SCMCHLB 40 ; with calls to $$PRTPC^SCAPMC() and $$PRPTTPC^SCAPMC(). 41 ; Examples: 42 ; ARRAY(2290,"PCP","2290-406-34-PCP")= Data 43 ; ARRAY(345,"PROV-P","2290-405-0-AP")= Data 44 ; DELETE - 1=Process a delete type ZPC segment (all fields null) 45 ;Output: 46 ; Array of ZPC segments 47 ; 48 NEW DATA,DATE,ID,ID1,LINETAG,SUB,TYPE,VAFZPC 49 ; 50 S SUB=0 51 F S SUB=$O(ARRAY(SUB)) Q:'SUB D ; 52 . S TYPE="" 53 . F S TYPE=$O(ARRAY(SUB,TYPE)) Q:TYPE="" D ; 54 .. S ID="" 55 .. F S ID=$O(ARRAY(SUB,TYPE,ID)) Q:ID="" D ; 56 ... S DATA=$G(ARRAY(SUB,TYPE,ID)) 57 ... I $G(DELETE) S DATA="^^^" ;A Delete type ZPC segment 58 ... E D ;....................A ZPC segment with data 59 .... ;Get dates 60 .... S DATE(9)=$P(DATA,U,9) 61 .... S DATE(10)=$P(DATA,U,10) 62 .... S DATE(14)=$P(DATA,U,14) ;Preceptor start date 63 .... S DATE(15)=$P(DATA,U,15) ;Preceptor end date 64 .... I DATE(14),DATE(14)>DATE(9) S DATE(9)=DATE(14) 65 .... I DATE(15) D ; 66 ..... I 'DATE(10) S DATE(10)=DATE(15) Q 67 ..... I DATE(15)<DATE(10) S DATE(10)=DATE(15) 68 .... ; 69 .... ;Provider^AssignDate^UnassignDate^ProviderType 70 .... S DATA=$P(DATA,U,1)_"^"_DATE(9)_"^"_DATE(10) 71 ....; PATCH 515 DLL ADD NEW ROLES (TPA,CCM,PM) 72 ....; OLD CODE = S DATA=DATA_"^"_$S(ID["AP":"AP",1:"PCP") 73 ....S ROLE=$P(ID,"-",4) I $G(ROLE)="" S ROLE="PCP" 74 ....S DATA=DATA_"^"_ROLE 75 ... ; 76 ... D BLDZPC^SCMCHLS ;..Build segment ; og/sd/524 77 ... D CPYZPC^SCMCHLS ;..Copy segment into array ; og/sd/524 78 Q 79 ; 80 DFN(ND) ;Find DFN from zero node of Patient Team Position Assign (404.43). 81 ;Input: 82 ; ND - Zero node of 404.43 83 ;Output: 84 ; DFN - Patient IEN 85 ; "" - No valid DFN found 86 ; 87 S DFN=$P(ND,U,1) 88 I DFN S DFN=$P($G(^SCPT(404.42,DFN,0)),U,1) 89 Q DFN 90 ; 91 ADJID(ARRAY,SCIEN) ;Adjust ID to include Pt Tm Pos Assign pointer 92 ;Example: From this: 424-34-AP 93 ; To this: 2290-424-34-AP 94 ;Input: 95 ; ARRAY - Array to be processed 96 ; SCIEN - 404.43 IEN to be added to ID 97 ; 98 NEW ADJID,ID,NUM,TMP,TYPE 99 ; 100 ;Build TMP() array using adjusted ID 101 S NUM=0 102 F S NUM=$O(ARRAY(NUM)) Q:'NUM D ; 103 . S TYPE="" 104 . F S TYPE=$O(ARRAY(NUM,TYPE)) Q:TYPE="" D ; 105 .. S ID="" 106 .. F S ID=$O(ARRAY(NUM,TYPE,ID)) Q:ID="" D ; 107 ... S ADJID=SCIEN_"-"_ID ;..Add 404.43 IEN 108 ... S TMP(NUM,TYPE,ADJID)=ARRAY(NUM,TYPE,ID) 109 ; 110 ;Replace ARRAY() with adjusted TMP() array. 111 Q:'$D(TMP) 112 KILL ARRAY 113 M ARRAY=TMP ;Copy TMP() into ARRAY() 114 Q 115 ; 116 CHECK(VARPTR) ;Validate event variable pointer. 117 ;Input: 118 ; VARPTR - EVENT POINTER field of PCMM HL7 EVENT (#404.48) 119 ;Output: 120 ; SCIEN - IEN portion of variable pointer 121 ; SCGLB - Global portion of variable pointer 122 ;Return: 123 ; 0: Invalid variable pointer format 124 ; 1: Valid pointer 125 ; 2: No data. Entry has been deleted. Send a delete to NPCD. 126 ; 127 NEW CHK,GLB 128 ; 129 S SCIEN=$P(VARPTR,";") ;....IEN portion of variable pointer 130 S SCGLB=$P(VARPTR,";",2) ;..Global portion of variable pointer 131 ; 132 ;Return zero if variable pointer is invalid. 133 I 'SCIEN Q 0 134 S CHK=0 D I CHK Q 0 135 . Q:SCGLB="SCPT(404.43," 136 . Q:SCGLB="SCTM(404.52," 137 . Q:SCGLB="SCTM(404.53," 138 . S CHK=1 139 ; 140 ;Is there data for this IEN? 141 S GLB="^"_SCGLB_SCIEN_",0)" 142 I '$D(@GLB) Q 2 ;..Entry has been deleted 143 Q 1 1 SCMCHLB1 ;BP/DJB - PCMM HL7 Bld Segment Array Cont. ; 8/17/99 9:29am 2 ;;5.3;Scheduling;**177,515**;May 01, 1999;Build 14 3 ; 4 SEGMENTS(DFN,SUB) ;Build EVN & PID segments 5 ;Input: 6 ; DFN - Patient IEN 7 ; SUB - Value for 1st Subscript 8 ;Output: 9 ; XMITARRY() - Array of EVN & PID segments 10 ; 11 NEW LINETAG,SEGMENTS,SEGNAME,SEGORD 12 NEW EVNTDATE,EVNTHL7,VAFARRY,VAFEVN,VAFPID,VAFSTR 13 ; 14 ;Initialize variables 15 Q:'$G(DFN) ;Required for PID segment 16 Q:'$G(SUB) 17 S EVNTDATE=DT 18 S EVNTHL7="A08" 19 ; 20 ;Get array of segments to be built 21 D SEGMENTS^SCMCHLS(EVNTHL7,"SEGMENTS") 22 ; 23 ;Loop thru segments array. Ignore ZPC segment - already built. 24 S SEGORD=0 25 F S SEGORD=+$O(SEGMENTS(SEGORD)) Q:'SEGORD D ; 26 . S SEGNAME="" 27 . F S SEGNAME=$O(SEGMENTS(SEGORD,SEGNAME)) Q:SEGNAME="" D ; 28 .. Q:SEGNAME="ZPC" ;.................ZPC already built 29 .. S VAFSTR=SEGMENTS(SEGORD,SEGNAME) ;String of segment fields 30 .. S LINETAG="BLD"_SEGNAME 31 .. D @LINETAG^SCMCHLS ;...............Build segment 32 .. S LINETAG="CPY"_SEGNAME 33 .. D @LINETAG^SCMCHLS ;...............Copy segment into array 34 Q 35 ; 36 ZPC(ARRAY,DELETE) ;Loop thru array and build array of ZPC segments. 37 ; 38 ;Input: 39 ; ARRAY - Array to be processed. This array was built in ^SCMCHLB 40 ; with calls to $$PRTPC^SCAPMC() and $$PRPTTPC^SCAPMC(). 41 ; Examples: 42 ; ARRAY(2290,"PCP","2290-406-34-PCP")= Data 43 ; ARRAY(345,"PROV-P","2290-405-0-AP")= Data 44 ; DELETE - 1=Process a delete type ZPC segment (all fields null) 45 ;Output: 46 ; Array of ZPC segments 47 ; 48 NEW DATA,DATE,ID,ID1,LINETAG,NUM,TYPE,VAFZPC 49 ; 50 S NUM=0 51 F S NUM=$O(ARRAY(NUM)) Q:'NUM D ; 52 . S TYPE="" 53 . F S TYPE=$O(ARRAY(NUM,TYPE)) Q:TYPE="" D ; 54 .. S ID="" 55 .. F S ID=$O(ARRAY(NUM,TYPE,ID)) Q:ID="" D ; 56 ... S DATA=$G(ARRAY(NUM,TYPE,ID)) 57 ... I $G(DELETE) S DATA="^^^" ;A Delete type ZPC segment 58 ... E D ;....................A ZPC segment with data 59 .... ;Get dates 60 .... S DATE(9)=$P(DATA,U,9) 61 .... S DATE(10)=$P(DATA,U,10) 62 .... S DATE(14)=$P(DATA,U,14) ;Preceptor start date 63 .... S DATE(15)=$P(DATA,U,15) ;Preceptor end date 64 .... I DATE(14),DATE(14)>DATE(9) S DATE(9)=DATE(14) 65 .... I DATE(15) D ; 66 ..... I 'DATE(10) S DATE(10)=DATE(15) Q 67 ..... I DATE(15)<DATE(10) S DATE(10)=DATE(15) 68 .... ; 69 .... ;Provider^AssignDate^UnassignDate^ProviderType 70 .... S DATA=$P(DATA,U,1)_"^"_DATE(9)_"^"_DATE(10) 71 ....; PATCH 515 DLL ADD NEW ROLES (TPA,CCM,PM) 72 ....; OLD CODE = S DATA=DATA_"^"_$S(ID["AP":"AP",1:"PCP") 73 ....S ROLE=$P(ID,"-",4) I $G(ROLE)="" S ROLE="PCP" 74 ....S DATA=DATA_"^"_ROLE 75 ... ; 76 ... S LINETAG="BLDZPC" 77 ... D @LINETAG^SCMCHLS ;..Build segment 78 ... S LINETAG="CPYZPC" 79 ... D @LINETAG^SCMCHLS ;..Copy segment into array 80 Q 81 ; 82 DFN(ND) ;Find DFN from zero node of Patient Team Position Assign (404.43). 83 ;Input: 84 ; ND - Zero node of 404.43 85 ;Output: 86 ; DFN - Patient IEN 87 ; "" - No valid DFN found 88 ; 89 S DFN=$P(ND,U,1) 90 I DFN S DFN=$P($G(^SCPT(404.42,DFN,0)),U,1) 91 Q DFN 92 ; 93 ADJID(ARRAY,SCIEN) ;Adjust ID to include Pt Tm Pos Assign pointer 94 ;Example: From this: 424-34-AP 95 ; To this: 2290-424-34-AP 96 ;Input: 97 ; ARRAY - Array to be processed 98 ; SCIEN - 404.43 IEN to be added to ID 99 ; 100 NEW ADJID,ID,NUM,TMP,TYPE 101 ; 102 ;Build TMP() array using adjusted ID 103 S NUM=0 104 F S NUM=$O(ARRAY(NUM)) Q:'NUM D ; 105 . S TYPE="" 106 . F S TYPE=$O(ARRAY(NUM,TYPE)) Q:TYPE="" D ; 107 .. S ID="" 108 .. F S ID=$O(ARRAY(NUM,TYPE,ID)) Q:ID="" D ; 109 ... S ADJID=SCIEN_"-"_ID ;..Add 404.43 IEN 110 ... S TMP(NUM,TYPE,ADJID)=ARRAY(NUM,TYPE,ID) 111 ; 112 ;Replace ARRAY() with adjusted TMP() array. 113 Q:'$D(TMP) 114 KILL ARRAY 115 M ARRAY=TMP ;Copy TMP() into ARRAY() 116 Q 117 ; 118 CHECK(VARPTR) ;Validate event variable pointer. 119 ;Input: 120 ; VARPTR - EVENT POINTER field of PCMM HL7 EVENT (#404.48) 121 ;Output: 122 ; SCIEN - IEN portion of variable pointer 123 ; SCGLB - Global portion of variable pointer 124 ;Return: 125 ; 0: Invalid variable pointer format 126 ; 1: Valid pointer 127 ; 2: No data. Entry has been deleted. Send a delete to NPCD. 128 ; 129 NEW CHK,GLB 130 ; 131 S SCIEN=$P(VARPTR,";") ;....IEN portion of variable pointer 132 S SCGLB=$P(VARPTR,";",2) ;..Global portion of variable pointer 133 ; 134 ;Return zero if variable pointer is invalid. 135 I 'SCIEN Q 0 136 S CHK=0 D I CHK Q 0 137 . Q:SCGLB="SCPT(404.43," 138 . Q:SCGLB="SCTM(404.52," 139 . Q:SCGLB="SCTM(404.53," 140 . S CHK=1 141 ; 142 ;Is there data for this IEN? 143 S GLB="^"_SCGLB_SCIEN_",0)" 144 I '$D(@GLB) Q 2 ;..Entry has been deleted 145 Q 1
Note:
See TracChangeset
for help on using the changeset viewer.
