- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORN52D.m
r613 r623 1 PSORN52D ;BIR/LE - files new and renewal entries con't ;02/27/04 2 ;;7.0;OUTPATIENT PHARMACY;**143,219,239,225**;DEC 1997;Build 29 3 ;External reference VADPT supported by DBIA 10061 4 Q 5 GET ;must have FILE and PSORENW variables to pull default data for ICD and SC/EI for SC>50% Rx's from file 52 6 N ARRAY,ERR,SUBF,RXN,II,JJ,ORXN,SUBFLD,PENDSC,PSOPATST,PSOIBQF 7 I FILE=52 S SUBF=52.052311,SUBFLD=52311,RXN=PSORENW("IRXN"),(SRXN,ORXN)=PSORENW("OIRXN") S:($TR($G(^PSRX(SRXN,"IBQ")),"^")'="") PSOIBQF=1 8 ;$TR checks for when patient status is exempt, null IBQ node was set for exempts, or SC>50 - data is in ICD node 9 I FILE=52.41 S SUBF=52.41311,SUBFLD=311,(SRXN,RXN)=ORD,ORXN=PSORENW("OIRXN") S:($TR($G(^PS(52.41,SRXN,"IBQ")),"^")'="") PSOIBQF=1 10 D GETS^DIQ(FILE,SRXN,SUBFLD_"*","I","ARRAY","ERR") 11 K PSORX("ICD"),PSOX("ICD") 12 Q:'$D(ARRAY) 13 I FILE=52.41 S PENDSC=$$GET1^DIQ(52.41,ORD,"17"),PENDSC=$S(PENDSC="SC":1,PENDSC="NSC":0,1:"") 14 S PSOPATST=$$GET1^DIQ(52,RXN_",",3,"I") 15 ; 16 G1 ;get ICD, if no IBQ node get SC/EI's 17 F II=1:1:8 Q:'$D(ARRAY(SUBF,(II_","_SRXN_","))) D 18 . S PSORX("ICD",II)=ARRAY(SUBF,(II_","_SRXN_","),.01,"I") S:FILE=52.41 PSONEW("ICD",II)=PSORX("ICD",II) 19 . Q:II>1!($G(PSOIBQF)) ;only need ei's from 1st node; all nodes same for SC/EI 20 . F JJ=1:1:8 I ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")=1!(ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")=0) D 21 .. I JJ=1 S (PSOANSQ(RXN,"VEH"),PSORX(ORXN,"VEH"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 22 .. I JJ=2 S (PSOANSQ(RXN,"RAD"),PSORX(ORXN,"RAD"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 23 .. I JJ=4 S (PSOANSQ(RXN,"PGW"),PSORX(ORXN,"PGW"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 24 .. I JJ=5 S (PSOANSQ(RXN,"MST"),PSORX(ORXN,"MST"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 25 .. I JJ=6 S (PSOANSQ(RXN,"HNC"),PSORX(ORXN,"HNC"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 26 .. I JJ=7 S (PSOANSQ(RXN,"CV"),PSORX(ORXN,"CV"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 27 .. I JJ=8 S (PSOANSQ(RXN,"SHAD"),PSORX(ORXN,"SHAD"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 28 I '$G(PSOIBQF) S II=1,JJ=3 D 29 . I PSOSCP>49&(FILE=52.41) S (PSOANSQ(RXN,"SC>50"),PSORX(ORXN,"SC>50"),PSOANSQ("SC>50"))=PENDSC Q 30 . I PSOSCP>49&(FILE'=52.41) S:$D(ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")) (PSOANSQ(RXN,"SC>50"),PSOANSQ("SC>50"),PSORX(ORXN,"SC>50"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 31 . ; when patient status is exempt use SC>50 variable to differenciate regular SC<50 and exempt SC<50 32 . I PSOSCP<50&($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)=1) D 33 .. I FILE=52.41 S (PSOANSQ(RXN,"SC>50"),PSORX(ORXN,"SC>50"),PSOANSQ("SC>50"))=PENDSC Q 34 .. S:$G(ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")) (PSOANSQ(RXN,"SC>50"),PSORX(ORXN,"SC>50"),PSOANSQ("SC>50"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") 35 . I PSOSCP<50&($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)'=1) D 36 .. I FILE=52.41 S (PSOANSQ(RXN,"SC"),PSORX(ORXN,"SC"),PSOANSQ("SC"))=PENDSC Q 37 .. S:$D(ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")) (PSOANSQ(RXN,"SC"),PSORX(ORXN,"SC"),PSOANSQ("SC"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") 38 Q 39 ; 40 FILE ; 41 Q:'$D(^PSRX(PSOX("OIRXN"),"ICD")) 42 N II F II=1:1:8 Q:$G(^PSRX(PSOX("OIRXN"),"ICD",II,0))="" D 43 . S ^PSRX(PSOX("IRXN"),"ICD",II,0)=$G(^PSRX(PSOX("OIRXN"),"ICD",II,0)) 44 . S:$P(^PSRX(PSOX("IRXN"),"ICD",II,0),"^",1)'="" ^PSRX(PSOX("IRXN"),"ICD","B",$P(^PSRX(PSOX("IRXN"),"ICD",II,0),"^",1),II)="" 45 I II>1 S ^PSRX(PSOX("IRXN"),"ICD",0)="^52.052311^"_(II-1)_"^"_(II-1) 46 Q 47 FILE2 ;file ICD's on existing node or build new nodes 48 ;note: variable PSOSCP2 is only available from CPRS Edit API and MISS 49 ; sub-routine below. 50 N D,RXN,II,TYPE,DATA,DATA1,PSOPATST 51 I $G(PSOX("IRXN")) S PSOPATST=$$GET1^DIQ(52,PSOX("IRXN")_",",3,"I") 52 ;I '$G(PSONEW("PATIENT STATUS")) I $G(PSOX("IRXN")) S PSONEW("PATIENT STATUS")=$$GET1^DIQ(52,PSOX("IRXN")_",",3,"I") 53 I $G(PSOSCP2)!($G(PSOFDR)&($G(ORD))) D 54 .;if RX edited in CPRS delete all but what is sent from CPRS 55 . K ^PSRX(PSOX("IRXN"),"ICD"),^PSRX(PSOX("IRXN"),"IBQ") 56 S DATA="^^^^^^^^",(DATA1,TYPE)="" 57 S $P(DATA,U,4)=$S(PSOSCP>49:$G(PSOANSQ("SC>50")),PSOSCP<50&($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)=1):$G(PSOANSQ("SC>50")),PSOSCP<50&(PSOSCP'=""):$G(PSOANSQ("SC")),1:"") 58 F S TYPE=$O(PSOANSQ(PSOX("IRXN"),TYPE)) Q:TYPE="" D 59 . I TYPE="VEH" S $P(DATA,U,2)=PSOANSQ(PSOX("IRXN"),"VEH") 60 . I TYPE="RAD" S $P(DATA,U,3)=PSOANSQ(PSOX("IRXN"),"RAD") 61 . I TYPE="PGW" S $P(DATA,U,5)=PSOANSQ(PSOX("IRXN"),"PGW") 62 . I TYPE="MST" S $P(DATA,U,6)=PSOANSQ(PSOX("IRXN"),"MST") 63 . I TYPE="HNC" S $P(DATA,U,7)=PSOANSQ(PSOX("IRXN"),"HNC") 64 . I TYPE="CV" S $P(DATA,U,8)=PSOANSQ(PSOX("IRXN"),"CV") 65 . I TYPE="SHAD" S $P(DATA,U,9)=PSOANSQ(PSOX("IRXN"),"SHAD") 66 I $O(PSORX("ICD","")) F D=1:1:8 Q:'$D(PSORX("ICD",D)) S $P(DATA,"^")=PSORX("ICD",D) D 67 . S ^PSRX(PSOX("IRXN"),"ICD",D,0)=DATA,$P(DATA,"^")="",^PSRX(PSOX("IRXN"),"ICD",0)="^52.052311P^"_D_"^"_D 68 . S:PSORX("ICD",D)'="" ^PSRX(PSOX("IRXN"),"ICD","B",PSORX("ICD",D),D)="" 69 E S ^PSRX(PSOX("IRXN"),"ICD",0)="^52.052311P^1^1",^PSRX(PSOX("IRXN"),"ICD",1,0)=$G(DATA) 70 I PSOSCP<50&(($TR(DATA,"^")'=""))&(($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)'=1)) D 71 .S DATA1=$G(PSOANSQ("SC"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"MST"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"VEH"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"RAD")) 72 .S DATA1=DATA1_"^"_$G(PSOANSQ(PSOX("IRXN"),"PGW"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"HNC"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"CV"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"SHAD")) 73 .S:($TR(DATA1,"^")'="") ^PSRX(PSOX("IRXN"),"IBQ")=DATA1 74 K PSORX("ICD") 75 Q 76 ; 77 RESET ;called from reset copay status PSOCPC 78 ;Must be available at this point: PSODA, PSOIBQ=SC^MST^AO^IR^EC^HNC^CV^SHAD 79 Q:'$D(PSODA)!('$D(PSOIBQ)) 80 Q:'$D(^PSRX(PSODA)) 81 ;Q:'$D(^PSRX(PSODA,"ICD")) ;if old Rx and no ICD's defined; don't set 82 N I,DATA,PSOICD 83 S:$D(^PSRX(PSODA,"ICD")) PSOICD=1 84 I '$G(DFN) S DFN=$$GET1^DIQ(52,PSODA_",",2,"I") 85 S DATA="^^^^^^^^" 86 F I=1:1:8 D 87 . I I=1 S $P(DATA,"^",4)=$P(PSOIBQ,"^",I) 88 . I I=2 S $P(DATA,"^",6)=$P(PSOIBQ,"^",I) 89 . I I=3 S $P(DATA,"^",2)=$P(PSOIBQ,"^",I) 90 . I I=4 S $P(DATA,"^",3)=$P(PSOIBQ,"^",I) 91 . I I=5 S $P(DATA,"^",5)=$P(PSOIBQ,"^",I) 92 . I I=6 S $P(DATA,"^",7)=$P(PSOIBQ,"^",I) 93 . I I=7 S $P(DATA,"^",8)=$P(PSOIBQ,"^",I) 94 . I I=8 S $P(DATA,"^",9)=$P(PSOIBQ,"^",I) 95 I $G(PSOICD) S I=0 F S I=$O(^PSRX(PSODA,"ICD",I)) Q:I=""!(I'?1N.NN) D 96 . Q:'$D(^PSRX(PSODA,"ICD",I,0)) 97 . S $P(^PSRX(PSODA,"ICD",I,0),"^",2,9)=$P(DATA,"^",2,9) 98 ; for pre-cidc RX 99 I '$G(PSOICD) S ^PSRX(PSODA,"ICD",1,0)="^"_$P(DATA,"^",2,9),^PSRX(PSODA,"ICD",0)="^52.052311P^1^1" 100 Q 101 ; 102 SCP ;Called from multiple routines - DFN or PSODFN variable must be available to call this subroutine. 103 I '$G(DFN) S DFN=+$G(PSODFN) 104 D ELIG^VADPT S PSOANSQ("SC>50")="",(PSOSCA,PSOSCP)="",PSOSCP=$P(VAEL(3),U,2) 105 S:PSOSCP=""&($P(VAEL(3),U)=1) PSOSCP=0 106 S PSOSCA=$$SC^SDCO22(DFN) 107 K VAEL 108 Q 109 SHAD ; 110 N XX 111 I $P($G(PSOPIBQ),U,8)]"" S XX=$P(PSOPIBQ,U,8) I XX=0!(XX=1) S PSOANSQ(PSOX("IRXN"),"SHAD")=XX Q 112 I $P($G(^PSRX(RXN,"ICD",1,0)),U,9)]"" S XX=$P($G(^PSRX(PSOX("IRXN"),"ICD",1,0)),U,9) S:XX=0!(XX=1) PSOANSQ(PSOX("IRXN"),"SHAD")=XX 113 Q 114 ; 115 SET3 ;for when patient status is exempt or SC>50 116 N PSOPATST S PSOPATST=PSORX("PATIENT STATUS") 117 I PSORX("PATIENT STATUS")'?1N.N S PSOPATST="",PSOPATST=$O(^PS(53,"B",PSORX("PATIENT STATUS"),PSOPATST)) 118 F JJJ=2:1:9 I $P(PSOOICD,"^",JJJ)=0!($P(PSOOICD,"^",JJJ)=1) D 119 . I JJJ=2 S PSORX(PSOIBOLD,"VEH")=$P(PSOOICD,"^",JJJ) 120 . I JJJ=3 S PSORX(PSOIBOLD,"RAD")=$P(PSOOICD,"^",JJJ) 121 . I JJJ=4 D 122 .. S:PSOSCP<50 PSORX(PSOIBOLD,"SC")=$P(PSOOICD,"^",JJJ) 123 .. S:PSOSCP>49!($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)=1) PSORX(PSOIBOLD,"SC>50")=$P(PSOOICD,"^",JJJ) 124 . I JJJ=5 S PSORX(PSOIBOLD,"PGW")=$P(PSOOICD,"^",JJJ) 125 . I JJJ=6 S PSORX(PSOIBOLD,"MST")=$P(PSOOICD,"^",JJJ) 126 . I JJJ=7 S PSORX(PSOIBOLD,"HNC")=$P(PSOOICD,"^",JJJ) 127 . I JJJ=8 S PSORX(PSOIBOLD,"CV")=$P(PSOOICD,"^",JJJ) 128 . I JJJ=9 S PSORX(PSOIBOLD,"SHAD")=$P(PSOOICD,"^",JJJ) 129 K JJJ,PSOOICD 130 Q 1 PSORN52D ;BIR/LE - files new and renewal entries con't ;02/27/04 2 ;;7.0;OUTPATIENT PHARMACY;**143,219,239**;DEC 1997 3 ;External reference VADPT supported by DBIA 10061 4 Q 5 GET ;must have FILE and PSORENW variables to pull default data for ICD and SC/EI for SC>50% Rx's from file 52 6 N ARRAY,ERR,SUBF,RXN,II,JJ,ORXN,SUBFLD,PENDSC,PSOPATST,PSOIBQF 7 I FILE=52 S SUBF=52.052311,SUBFLD=52311,RXN=PSORENW("IRXN"),(SRXN,ORXN)=PSORENW("OIRXN") S:($TR($G(^PSRX(SRXN,"IBQ")),"^")'="") PSOIBQF=1 8 ; $TR checks for when patient status is exempt, null IBQ node was set for exempts, or SC>50 - data is in ICD node 9 I FILE=52.41 S SUBF=52.41311,SUBFLD=311,(SRXN,RXN)=ORD,ORXN=PSORENW("OIRXN") S:($TR($G(^PS(52.41,SRXN,"IBQ")),"^")'="") PSOIBQF=1 10 D GETS^DIQ(FILE,SRXN,SUBFLD_"*","I","ARRAY","ERR") 11 K PSORX("ICD"),PSOX("ICD") 12 Q:'$D(ARRAY) 13 I FILE=52.41 S PENDSC=$$GET1^DIQ(52.41,ORD,"17"),PENDSC=$S(PENDSC="SC":1,PENDSC="NSC":0,1:"") 14 S PSOPATST=$$GET1^DIQ(52,RXN_",",3,"I") 15 ; 16 G1 ;get ICD, if no IBQ node get SC/EI's 17 F II=1:1:8 Q:'$D(ARRAY(SUBF,(II_","_SRXN_","))) D 18 . S PSORX("ICD",II)=ARRAY(SUBF,(II_","_SRXN_","),.01,"I") S:FILE=52.41 PSONEW("ICD",II)=PSORX("ICD",II) 19 . Q:II>1!($G(PSOIBQF)) ;only need ei's from 1st node; all nodes same for SC/EI 20 . F JJ=1:1:7 I ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")=1!(ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")=0) D 21 .. I JJ=1 S (PSOANSQ(RXN,"VEH"),PSORX(ORXN,"VEH"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 22 .. I JJ=2 S (PSOANSQ(RXN,"RAD"),PSORX(ORXN,"RAD"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 23 .. I JJ=4 S (PSOANSQ(RXN,"PGW"),PSORX(ORXN,"PGW"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 24 .. I JJ=5 S (PSOANSQ(RXN,"MST"),PSORX(ORXN,"MST"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 25 .. I JJ=6 S (PSOANSQ(RXN,"HNC"),PSORX(ORXN,"HNC"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 26 .. I JJ=7 S (PSOANSQ(RXN,"CV"),PSORX(ORXN,"CV"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 27 ; 28 I '$G(PSOIBQF) S II=1,JJ=3 D 29 . I PSOSCP>49&(FILE=52.41) S (PSOANSQ(RXN,"SC>50"),PSORX(ORXN,"SC>50"),PSOANSQ("SC>50"))=PENDSC Q 30 . I PSOSCP>49&(FILE'=52.41) S:$D(ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")) (PSOANSQ(RXN,"SC>50"),PSOANSQ("SC>50"),PSORX(ORXN,"SC>50"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") Q 31 . ; when patient status is exempt use SC>50 variable to differenciate regular SC<50 and exempt SC<50 32 . I PSOSCP<50&($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)=1) D 33 .. I FILE=52.41 S (PSOANSQ(RXN,"SC>50"),PSORX(ORXN,"SC>50"),PSOANSQ("SC>50"))=PENDSC Q 34 .. S:$G(ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")) (PSOANSQ(RXN,"SC>50"),PSORX(ORXN,"SC>50"),PSOANSQ("SC>50"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") 35 . I PSOSCP<50&($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)'=1) D 36 .. I FILE=52.41 S (PSOANSQ(RXN,"SC"),PSORX(ORXN,"SC"),PSOANSQ("SC"))=PENDSC Q 37 .. S:$D(ARRAY(SUBF,(II_","_SRXN_","),JJ,"I")) (PSOANSQ(RXN,"SC"),PSORX(ORXN,"SC"),PSOANSQ("SC"))=ARRAY(SUBF,(II_","_SRXN_","),JJ,"I") 38 ; 39 Q 40 ; 41 FILE ; 42 Q:'$D(^PSRX(PSOX("OIRXN"),"ICD")) 43 N II F II=1:1:8 Q:$G(^PSRX(PSOX("OIRXN"),"ICD",II,0))="" D 44 . S ^PSRX(PSOX("IRXN"),"ICD",II,0)=$G(^PSRX(PSOX("OIRXN"),"ICD",II,0)) 45 . S:$P(^PSRX(PSOX("IRXN"),"ICD",II,0),"^",1)'="" ^PSRX(PSOX("IRXN"),"ICD","B",$P(^PSRX(PSOX("IRXN"),"ICD",II,0),"^",1),II)="" 46 I II>1 S ^PSRX(PSOX("IRXN"),"ICD",0)="^52.052311^"_(II-1)_"^"_(II-1) 47 Q 48 FILE2 ;file ICD's on existing node or build new nodes 49 ;note: variable PSOSCP2 is only available from CPRS Edit API and MISS 50 ; sub-routine below. 51 N D,RXN,II,TYPE,DATA,DATA1,PSOPATST 52 I $G(PSOX("IRXN")) S PSOPATST=$$GET1^DIQ(52,PSOX("IRXN")_",",3,"I") 53 ;I '$G(PSONEW("PATIENT STATUS")) I $G(PSOX("IRXN")) S PSONEW("PATIENT STATUS")=$$GET1^DIQ(52,PSOX("IRXN")_",",3,"I") 54 I $G(PSOSCP2)!($G(PSOFDR)&($G(ORD))) D 55 .;if RX edited in CPRS delete all but what is sent from CPRS 56 . K ^PSRX(PSOX("IRXN"),"ICD"),^PSRX(PSOX("IRXN"),"IBQ") 57 ; 58 S DATA="^^^^^^^",(DATA1,TYPE)="" 59 S $P(DATA,U,4)=$S(PSOSCP>49:$G(PSOANSQ("SC>50")),PSOSCP<50&($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)=1):$G(PSOANSQ("SC>50")),PSOSCP<50&(PSOSCP'=""):$G(PSOANSQ("SC")),1:"") 60 ; 61 F S TYPE=$O(PSOANSQ(PSOX("IRXN"),TYPE)) Q:TYPE="" D 62 . I TYPE="VEH" S $P(DATA,U,2)=PSOANSQ(PSOX("IRXN"),"VEH") 63 . I TYPE="RAD" S $P(DATA,U,3)=PSOANSQ(PSOX("IRXN"),"RAD") 64 . I TYPE="PGW" S $P(DATA,U,5)=PSOANSQ(PSOX("IRXN"),"PGW") 65 . I TYPE="MST" S $P(DATA,U,6)=PSOANSQ(PSOX("IRXN"),"MST") 66 . I TYPE="HNC" S $P(DATA,U,7)=PSOANSQ(PSOX("IRXN"),"HNC") 67 . I TYPE="CV" S $P(DATA,U,8)=PSOANSQ(PSOX("IRXN"),"CV") 68 ; 69 I $O(PSORX("ICD","")) F D=1:1:8 Q:'$D(PSORX("ICD",D)) S $P(DATA,"^")=PSORX("ICD",D) D 70 . S ^PSRX(PSOX("IRXN"),"ICD",D,0)=DATA,$P(DATA,"^")="",^PSRX(PSOX("IRXN"),"ICD",0)="^52.052311P^"_D_"^"_D 71 . S:PSORX("ICD",D)'="" ^PSRX(PSOX("IRXN"),"ICD","B",PSORX("ICD",D),D)="" 72 E S ^PSRX(PSOX("IRXN"),"ICD",0)="^52.052311P^1^1",^PSRX(PSOX("IRXN"),"ICD",1,0)=$G(DATA) 73 ; 74 I PSOSCP<50&(($TR(DATA,"^")'=""))&(($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)'=1)) D 75 .S DATA1=$G(PSOANSQ("SC"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"MST"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"VEH"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"RAD")) 76 .S DATA1=DATA1_"^"_$G(PSOANSQ(PSOX("IRXN"),"PGW"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"HNC"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"CV")) 77 .S:($TR(DATA1,"^")'="") ^PSRX(PSOX("IRXN"),"IBQ")=DATA1 78 K PSORX("ICD") 79 Q 80 ; 81 RESET ;called from reset copay status PSOCPC 82 ;Must be available at this point: PSODA, PSOIBQ=SC^MST^AO^IR^EC^HNC^CV 83 Q:'$D(PSODA)!('$D(PSOIBQ)) 84 Q:'$D(^PSRX(PSODA)) 85 ;Q:'$D(^PSRX(PSODA,"ICD")) ;if old Rx and no ICD's defined; don't set 86 N I,DATA,PSOICD 87 S:$D(^PSRX(PSODA,"ICD")) PSOICD=1 88 I '$G(DFN) S DFN=$$GET1^DIQ(52,PSODA_",",2,"I") 89 S DATA="^^^^^^^" 90 F I=1:1:7 D 91 . I I=1 S $P(DATA,"^",4)=$P(PSOIBQ,"^",I) 92 . I I=2 S $P(DATA,"^",6)=$P(PSOIBQ,"^",I) 93 . I I=3 S $P(DATA,"^",2)=$P(PSOIBQ,"^",I) 94 . I I=4 S $P(DATA,"^",3)=$P(PSOIBQ,"^",I) 95 . I I=5 S $P(DATA,"^",5)=$P(PSOIBQ,"^",I) 96 . I I=6 S $P(DATA,"^",7)=$P(PSOIBQ,"^",I) 97 . I I=7 S $P(DATA,"^",8)=$P(PSOIBQ,"^",I) 98 ; 99 I $G(PSOICD) S I=0 F S I=$O(^PSRX(PSODA,"ICD",I)) Q:I=""!(I'?1N.NN) D 100 . Q:'$D(^PSRX(PSODA,"ICD",I,0)) 101 . S $P(^PSRX(PSODA,"ICD",I,0),"^",2,8)=$P(DATA,"^",2,8) 102 ; for pre-cidc RX 103 I '$G(PSOICD) S ^PSRX(PSODA,"ICD",1,0)="^"_$P(DATA,"^",2,8),^PSRX(PSODA,"ICD",0)="^52.052311P^1^1" 104 Q 105 ; 106 SCP ;Called from multiple routines - DFN or PSODFN variable must be available to call this subroutine. 107 I '$G(DFN) S DFN=+$G(PSODFN) 108 D ELIG^VADPT S PSOANSQ("SC>50")="",(PSOSCA,PSOSCP)="",PSOSCP=$P(VAEL(3),U,2) 109 S:PSOSCP=""&($P(VAEL(3),U)=1) PSOSCP=0 110 S PSOSCA=$$SC^SDCO22(DFN) 111 K VAEL 112 Q
Note:
See TracChangeset
for help on using the changeset viewer.
