Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCHLB2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCHLB2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCHLB2.m
r613 r623 1 SCMCHLB2 ;BPOI/DJB - PCMM HL7 Bld Segment Array Deletes;3/6/00 2 ;;5.3;Scheduling;**177,204,210,224,524**;08/13/93;Build 29 3 ; 4 PTP ;Entry has been deleted from file 404.43. Send deletes to NPCD. 5 ; 6 NEW DFN,TP 7 D GETEVENT Q:'DFN ;..Get DFN & TP from PCMM HL7 EVENT file 8 D PTPD(SCIEN) ;.......Send delete 9 ;alb/rpm;Patch 224 Decrement max msg counter 10 I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1 11 Q 12 ; 13 PTPD(PTPI) ;From PCMM HL7 ID file, get all ID's whose 1st piece equals PTPI, 14 ;and send a delete segment. 15 ;Input: PTPI - 404.43 IEN (1st piece of ID) 16 ; 17 ;djb/bp Added SCSEQ per Patch 210[rel 204]. 18 NEW DATA,ID,LINETAG,SCSEQ,VAFZPC 19 ; 20 S ID=PTPI_"-" 21 F S ID=$O(^SCPT(404.49,"B",ID)) Q:ID=""!($P(ID,"-",1)'=PTPI) D ; 22 . N SUB ; og/sd/524 23 . S SUB=PTPI,DATA="^^^" ;........A Delete type ZPC segment 24 . ;djb/bp Patch 210. Eliminate indirection[rel 204] 25 . D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA) 26 . D CPYZPC^SCMCHLS ;..Copy segment into array (needs ID & VAFZPC) 27 Q:'$D(@XMITARRY) 28 D SEGMENTS^SCMCHLB1(DFN,PTPI) ;Bld array of EVN,PID segments 29 Q 30 ; 31 POS ;Entry has been deleted from file 404.52. Send deletes to NPCD. 32 ; 33 NEW DATA,DFN,ID,LINETAG,ND,POS,PTPI,VAFZPC 34 ; 35 ;From PCMM HL7 ID file, get all ID's whose 2nd piece equals SCIEN, 36 ;Build array sorted by: DFN 37 ; 404.43 IEN 38 ; ID 39 ;djb/bp Fix <STORE> errors for NOIS BIG-1199-71271. 40 ; Replace local array POS() with global array. 41 S POS="^TMP(""PCMM"",""POS"","_$J_")" 42 KILL @POS 43 ; 44 S ID="" 45 F S ID=$O(^SCPT(404.49,"B",ID)) Q:ID="" D ; 46 . Q:$P(ID,"-",2)'=SCIEN 47 . S PTPI=$P(ID,"-",1) ;...............404.43 IEN 48 . S ND=$G(^SCPT(404.43,PTPI,0)) 49 . Q:($P(ND,U,5)'=1) ;................Must be Primary Care 50 . S DFN=$$DFN^SCMCHLB1(ND) Q:'DFN ;..Get patient 51 . ; 52 . S @POS@(DFN,PTPI,ID)="" ;djb/bp BIG-1199-71271 53 . ; 54 Q:'$D(@POS) 55 ; 56 ;Process array 57 S DFN=0 58 F S DFN=$O(@POS@(DFN)) Q:'DFN D ;djb/bp BIG-1199-71271 59 . S PTPI=0 60 . F S PTPI=$O(@POS@(DFN,PTPI)) Q:'PTPI D ;djb/bp BIG-1199-71271 61 .. NEW SCSEQ ;djb/bp Added per Patch 210. 62 .. ;alb/rpm;Patch 224 Decrement max msg counter 63 .. I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1 64 .. D SEGMENTS^SCMCHLB1(DFN,PTPI) ;Bld array of EVN,PID segments 65 .. S ID="" 66 .. F S ID=$O(@POS@(DFN,PTPI,ID)) Q:ID="" D ;djb/bp BIG-1199-71271 67 ... N SUB ; og/sd/524 68 ... S SUB=PTPI,DATA="^^^" ;........A Delete type ZPC segment 69 ... ;djb/bp Patch 210. Eliminate indirection[rel 204] 70 ... D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA) 71 ... D CPYZPC^SCMCHLS ;..Copy segment into array (needs ID & VAFZPC) 72 ; 73 KILL @POS ;djb/bp BIG-1199-71271 74 Q 75 ; 76 PRE ;Entry has been deleted from file 404.53. Send deletes to NPCD. 77 ;**** 78 ;Currently, deletes to 404.53 are not allowed if there are 79 ;patients assigned. 80 ;**** 81 ;alb/rpm;Patch 224 Decrement max msg counter 82 ;Uncomment the following line if this tag becomes active 83 ;I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1 84 Q 85 ; 86 GETEVENT ;Get data from PCMM HL7 EVENT file 87 ;Return: DFN - Patient IEN 88 ; TP - Team Position 89 ; 90 NEW IEN,ND,PTR 91 ; 92 ;If in manual mode, get SCEVIEN (404.48 IEN). 93 I $G(SCMANUAL) D ; 94 . S (IEN,SCEVIEN)=0 95 . F S IEN=$O(^SCPT(404.48,IEN)) Q:'IEN!SCEVIEN D ; 96 .. S PTR=$P($G(^(IEN,0)),U,7) Q:PTR="" 97 .. Q:PTR'=VARPTR 98 .. S SCEVIEN=IEN 99 ; 100 S ND=$G(^SCPT(404.48,SCEVIEN,0)) 101 S DFN=$P(ND,U,2) ;..Patient (DFN) 102 S TP=$P(ND,U,4) ;...Team Position 103 Q 1 SCMCHLB2 ;BP/DJB - PCMM HL7 Bld Segment Array Deletes ; 3/6/00 8:41am 2 ;;5.3;Scheduling;**177,204,210,224**;AUG 13, 1993 3 ; 4 PTP ;Entry has been deleted from file 404.43. Send deletes to NPCD. 5 ; 6 NEW DFN,TP 7 D GETEVENT Q:'DFN ;..Get DFN & TP from PCMM HL7 EVENT file 8 D PTPD(SCIEN) ;.......Send delete 9 ;alb/rpm;Patch 224 Decrement max msg counter 10 I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1 11 Q 12 ; 13 PTPD(PTPI) ;From PCMM HL7 ID file, get all ID's whose 1st piece equals PTPI, 14 ;and send a delete segment. 15 ;Input: PTPI - 404.43 IEN (1st piece of ID) 16 ; 17 ;djb/bp Added SCSEQ per Patch 210[rel 204]. 18 NEW DATA,ID,LINETAG,SCSEQ,VAFZPC 19 ; 20 S ID=PTPI_"-" 21 F S ID=$O(^SCPT(404.49,"B",ID)) Q:ID=""!($P(ID,"-",1)'=PTPI) D ; 22 . S DATA="^^^" ;........A Delete type ZPC segment 23 . ;djb/bp Patch 210. Eliminate indirection[rel 204] 24 . D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA) 25 . D CPYZPC^SCMCHLS ;..Copy segment into array (needs ID & VAFZPC) 26 Q:'$D(@XMITARRY) 27 D SEGMENTS^SCMCHLB1(DFN,PTPI) ;Bld array of EVN,PID segments 28 Q 29 ; 30 POS ;Entry has been deleted from file 404.52. Send deletes to NPCD. 31 ; 32 NEW DATA,DFN,ID,LINETAG,ND,POS,PTPI,VAFZPC 33 ; 34 ;From PCMM HL7 ID file, get all ID's whose 2nd piece equals SCIEN, 35 ;Build array sorted by: DFN 36 ; 404.43 IEN 37 ; ID 38 ;djb/bp Fix <STORE> errors for NOIS BIG-1199-71271. 39 ; Replace local array POS() with global array. 40 S POS="^TMP(""PCMM"",""POS"","_$J_")" 41 KILL @POS 42 ; 43 S ID="" 44 F S ID=$O(^SCPT(404.49,"B",ID)) Q:ID="" D ; 45 . Q:$P(ID,"-",2)'=SCIEN 46 . S PTPI=$P(ID,"-",1) ;...............404.43 IEN 47 . S ND=$G(^SCPT(404.43,PTPI,0)) 48 . Q:($P(ND,U,5)'=1) ;................Must be Primary Care 49 . S DFN=$$DFN^SCMCHLB1(ND) Q:'DFN ;..Get patient 50 . ; 51 . S @POS@(DFN,PTPI,ID)="" ;djb/bp BIG-1199-71271 52 . ; 53 Q:'$D(@POS) 54 ; 55 ;Process array 56 S DFN=0 57 F S DFN=$O(@POS@(DFN)) Q:'DFN D ;djb/bp BIG-1199-71271 58 . S PTPI=0 59 . F S PTPI=$O(@POS@(DFN,PTPI)) Q:'PTPI D ;djb/bp BIG-1199-71271 60 .. NEW SCSEQ ;djb/bp Added per Patch 210. 61 .. ;alb/rpm;Patch 224 Decrement max msg counter 62 .. I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1 63 .. D SEGMENTS^SCMCHLB1(DFN,PTPI) ;Bld array of EVN,PID segments 64 .. S ID="" 65 .. F S ID=$O(@POS@(DFN,PTPI,ID)) Q:ID="" D ;djb/bp BIG-1199-71271 66 ... S DATA="^^^" ;........A Delete type ZPC segment 67 ... ;djb/bp Patch 210. Eliminate indirection[rel 204] 68 ... D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA) 69 ... D CPYZPC^SCMCHLS ;..Copy segment into array (needs ID & VAFZPC) 70 ; 71 KILL @POS ;djb/bp BIG-1199-71271 72 Q 73 ; 74 PRE ;Entry has been deleted from file 404.53. Send deletes to NPCD. 75 ;**** 76 ;Currently, deletes to 404.53 are not allowed if there are 77 ;patients assigned. 78 ;**** 79 ;alb/rpm;Patch 224 Decrement max msg counter 80 ;Uncomment the following line if this tag becomes active 81 ;I $D(SCLIMIT) S SCLIMIT=SCLIMIT-1 82 Q 83 ; 84 GETEVENT ;Get data from PCMM HL7 EVENT file 85 ;Return: DFN - Patient IEN 86 ; TP - Team Position 87 ; 88 NEW IEN,ND,PTR 89 ; 90 ;If in manual mode, get SCEVIEN (404.48 IEN). 91 I $G(SCMANUAL) D ; 92 . S (IEN,SCEVIEN)=0 93 . F S IEN=$O(^SCPT(404.48,IEN)) Q:'IEN!SCEVIEN D ; 94 .. S PTR=$P($G(^(IEN,0)),U,7) Q:PTR="" 95 .. Q:PTR'=VARPTR 96 .. S SCEVIEN=IEN 97 ; 98 S ND=$G(^SCPT(404.48,SCEVIEN,0)) 99 S DFN=$P(ND,U,2) ;..Patient (DFN) 100 S TP=$P(ND,U,4) ;...Team Position 101 Q
Note:
See TracChangeset
for help on using the changeset viewer.
