Changeset 623 for WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLX1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLX1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLX1.m
r613 r623 1 GMPLX1 ; SLC/MKB/KER -- Problem List Person Utilities ; 04/15/2002 2 ;;2.0;Problem List;**3,26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 348 ^DPT( 6 ; DBIA 3106 ^DIC(49 7 ; DBIA 872 ^ORD(101 8 ; DBIA 10060 ^VA(200 9 ; DBIA 10062 7^VADPT 10 ; DBIA 10062 DEM^VADPT 11 ; DBIA 2716 $$GETSTAT^DGMSTAPI 12 ; DBIA 3457 $$GETCUR^DGNTAPI 13 ; DBIA 10104 $$REPEAT^XLFSTR 14 ; DBIA 10006 ^DIC 15 ; DBIA 10018 ^DIE 16 ; DBIA 10026 ^DIR 17 ; 18 PAT() ; Select patient -- returns DFN^NAME^BID 19 N DIC,X,Y,DFN,VADM,VA,PAT 20 P1 S DIC="^AUPNPAT(",DIC(0)="AEQM" D ^DIC I +Y<1 Q -1 21 I $P(Y,U,2)'=$P(^DPT(+Y,0),U) W $C(7),!!,"ERROR -- Please check your Patient Files #2 and #9000001 for inconsistencies.",! G P1 22 S DFN=+Y,PAT=Y D DEM^VADPT 23 S PAT=PAT_U_$E($P(PAT,U,2))_VA("BID"),AUPNSEX=$P(VADM(5),U) 24 I VADM(6) S PAT=PAT_U_+VADM(6) ; date of death 25 Q PAT 26 ; 27 VADPT(DFN) ; Get Service/Elig Flags 28 ; 29 ; Returns = 1/0/"" if Y/N/unknown 30 ; GMPSC Service Connected 31 ; GMPAGTOR Agent Orange Exposure 32 ; GMPION Ionizing Radiation Exposure 33 ; GMPGULF Persian Gulf Exposure 34 ; GMPMST Military Sexual Trauma 35 ; GMPHNC Head and/or Neck Cancer 36 ; GMPCV Combat Veteran 37 ; GMPSHD Shipboard Hazard and Defense 38 ; 39 N VAEL,VASV,VAERR,HNC,X D 7^VADPT S GMPSC=VAEL(3),GMPAGTOR=VASV(2) 40 S GMPION=VASV(3),X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"") 41 S GMPCV=0 I +$G(VASV(10)) S:DT'>$P($G(VASV(10,1)),U) GMPCV=1 ;CV 42 S GMPSHD=+$G(VASV(14,1)) ;SHAD 43 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"") 44 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),GMPHNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 45 Q 46 SCS(PROB,SC) ; Get Exposure/Conditions Strings 47 ; 48 ; Input PROB Pointer to Problem #9000011 49 ; 50 ; Returns SC Array passed by reference 51 ; SC(1)="AO/IR/EC/HNC/MST/CV/SHD" 52 ; SC(2)="A/I/E/H/M/C/S" 53 ; SC(3)="AIEHMCS" 54 ; 55 ; NOTE: Military Sexual Trauma (MST) is suppressed 56 ; if the current device is a printer. 57 ; 58 N ND,DA,FL,AO,IR,EC,HNC,MST,PTR S DA=+($G(PROB)) Q:+DA=0 59 S ND=$G(^AUPNPROB(+DA,1)),AO=+($P(ND,"^",11)),IR=+($P(ND,"^",12)) 60 S EC=+($P(ND,"^",13)),HNC=+($P(ND,"^",15)),MST=+($P(ND,"^",16)) 61 S CV=+($P(ND,"^",17)),SHD=+($P(ND,"^",18)) 62 S PTR=$$PTR^GMPLUTL4 63 I +AO>0 D 64 . S:$G(SC(1))'["AO" SC(1)=$G(SC(1))_"/AO" S:$G(SC(2))'["A" SC(2)=$G(SC(2))_"/A" S:$G(SC(3))'["A" SC(3)=$G(SC(3))_"A" 65 I +IR>0 D 66 . S:$G(SC(1))'["IR" SC(1)=$G(SC(1))_"/IR" S:$G(SC(2))'["I" SC(2)=$G(SC(2))_"/I" S:$G(SC(3))'["I" SC(3)=$G(SC(3))_"I" 67 I +EC>0 D 68 . S:$G(SC(1))'["EC" SC(1)=$G(SC(1))_"/EC" S:$G(SC(2))'["E" SC(2)=$G(SC(2))_"/E" S:$G(SC(3))'["E" SC(3)=$G(SC(3))_"E" 69 I +HNC>0 D 70 . S:$G(SC(1))'["HNC" SC(1)=$G(SC(1))_"/HNC" S:$G(SC(2))'["H" SC(2)=$G(SC(2))_"/H" S:$G(SC(3))'["H" SC(3)=$G(SC(3))_"H" 71 I +MST>0 D 72 . S:$G(SC(1))'["MST" SC(1)=$G(SC(1))_"/MST" S:$G(SC(2))'["M" SC(2)=$G(SC(2))_"/M" S:$G(SC(3))'["M" SC(3)=$G(SC(3))_"M" 73 I +CV>0 D 74 . S:$G(SC(1))'["CV" SC(1)=$G(SC(1))_"/CV" S:$G(SC(2))'["C" SC(2)=$G(SC(2))_"/C" S:$G(SC(3))'["C" SC(3)=$G(SC(3))_"C" 75 I +PTR'>0 D 76 . I +SHD>0 S:$G(SC(1))'["SHD" SC(1)=$G(SC(1))_"/SHD" S:$G(SC(2))'["D" SC(2)=$G(SC(2))_"/S" S:$G(SC(3))'["S" SC(3)=$G(SC(3))_"S" 77 S:$D(SC(1)) SC(1)=$$RS(SC(1)) S:$D(SC(2)) SC(2)=$$RS(SC(2)) 78 Q 79 SCCOND(DFN,SC) ; Get Service/Elig Flags (array) 80 ; Returns local array .SC passed by value 81 N HNC,VAEL,VASV,VAERR,X D 7^VADPT 82 S SC("DFN")=$G(DFN),SC("SC")=$P(VAEL(3),"^",1) 83 S SC("AO")=$P(VASV(2),"^",1) 84 S SC("IR")=$P(VASV(3),"^",1) 85 S X=$P($G(^DPT(DFN,.322)),U,10),SC("PG")=$S(X="Y":1,X="N":0,1:"") 86 S SC("CV")=0 I +$G(VASV(10)) S:DT'>$P($G(VASV(10,1)),U) SC("CV")=1 ;CV 87 S SC("SHD")=+$G(VASV(14,1)) ;SHAD 88 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),SC("MST")=$S(X="Y":1,X="N":0,1:"") 89 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),SC("HNC")=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 90 Q 91 ; 92 CKDEAD(DATE) ; Dead patient ... continue? Returns 1 if YES, 0 otherwise 93 N DIR,X,Y S DIR(0)="YA",DIR("B")="NO" 94 S DIR("A")="Are you sure you want to continue? " 95 S DIR("?",1)=" Enter YES to continue and add new problem(s) for this patient:",DIR("?")=" press <return> to select another action." 96 W $C(7),!!,"DATE OF DEATH: "_$$EXTDT^GMPLX(DATE) 97 D ^DIR 98 Q +Y 99 ; 100 REQPROV() ; Returns requesting provider 101 N DIR,X,Y 102 I $D(GMPLUSER) S Y=DUZ_U_$P(^VA(200,DUZ,0),U) Q Y 103 S DIR("?")="Enter the name of the provider responsible for this data." 104 S DIR(0)="PA^200:AEQM",DIR("A")="Provider: " 105 S:$G(GMPROV) DIR("B")=$P(GMPROV,U,2) W ! D ^DIR 106 I $D(DUOUT)!($D(DTOUT))!(+Y'>0) Q -1 107 Q Y 108 ; 109 NAME(USER) ; Formats user name into "Lastname,F" 110 N NAME,LAST,FIRST 111 S NAME=$P($G(^VA(200,+USER,0)),U) I '$L(NAME) Q "" 112 S LAST=$P(NAME,","),FIRST=$P(NAME,",",2) 113 S:$E(FIRST)=" " FIRST=$E(FIRST,2,99) 114 Q $E(LAST,1,15)_","_$E(FIRST) 115 ; 116 SERVICE(USER) ; Returns User's service/section from file #49 117 N X S X=+$P($G(^VA(200,USER,5)),U) 118 I $P($G(^DIC(49,X,0)),U,9)'="C" S X=0 119 S:X>0 X=X_U_$P($G(^DIC(49,X,0)),U) S:X'>0 X="" 120 Q X 121 ; 122 SERV(X) ; Return service name abbreviation 123 N NODE,ABBREV 124 S NODE=$G(^DIC(49,+X,0)) I NODE="" Q "" 125 S ABBREV=$P(NODE,U,2) I ABBREV="" S ABBREV=$E($P(NODE,U),1,4) 126 Q ABBREV_"/" 127 ; 128 CLINIC(LAST) ; Returns clinic from file #44 129 N X,Y,DIC,DIR S Y="" G:$E(GMPLVIEW("VIEW"))="S" CLINQ 130 S DIR(0)="FAO^1:30",DIR("A")="Clinic: " S:$L(LAST) DIR("B")=$P(LAST,U,2) 131 S DIR("?")="Enter the clinic to be associated with these problems, if available" 132 S DIR("??")="^D LISTCLIN^GMPLMGR1 W !,DIR(""?"")_"".""" 133 CLIN1 ; Ask Clinic 134 D ^DIR S:$D(DUOUT)!($D(DTOUT)) Y="^" S:Y="@" Y="" G:("^"[Y) CLINQ 135 S DIC="^SC(",DIC(0)="EMQ",DIC("S")="I $P(^(0),U,3)=""C""" 136 D ^DIC I Y'>0 W !?5,"Only clinics are allowed!",! G CLIN1 137 CLINQ ; Quit Asking 138 Q Y 139 ; 140 VIEW(USER) ; Returns user's preferred view 141 N X S X=$P($G(^VA(200,USER,125)),U) 142 Q X 143 ; 144 VOCAB() ; Select search vocabulary 145 N DIR,X,Y S DIR(0)="SAOM^N:NURSING;I:IMMUNOLOGIC;D:DENTAL;S:SOCIAL WORK;P:GENERAL PROBLEM" 146 S DIR("A")="Select Specialty Subset: ",DIR("B")="GENERAL PROBLEM" 147 S DIR("?",1)="Because many discipline-specific terms are synonyms to other terms," 148 S DIR("?",2)="they are not accessible unless you specify the appropriate subset of the" 149 S DIR("?",3)="Clinical Lexicon to select from. Choose from: Nursing" 150 S DIR("?",4)=$$REPEAT^XLFSTR(" ",48)_"Immunologic" 151 S DIR("?",5)=$$REPEAT^XLFSTR(" ",48)_"Dental" 152 S DIR("?",6)=$$REPEAT^XLFSTR(" ",48)_"Social Work" 153 S DIR("?")=$$REPEAT^XLFSTR(" ",48)_"General Problem" 154 D ^DIR S X=$S(Y="N":"NUR",Y="I":"IMM",Y="D":"DEN",Y="S":"SOC",Y="P":"PL1",1:"^") 155 Q X 156 ; 157 PARAMS ; Edit pkg parameters in file #125.99 158 N DIE,DA,DR,OLDVERFY,VERFY,BLANK S BLANK=" " 159 S OLDVERFY=+$P($G(^GMPL(125.99,1,0)),U,2) 160 S DIE="^GMPL(125.99,",DA=1,DR="1:6" D ^DIE 161 Q:+$P($G(^GMPL(125.99,1,0)),U,2)=OLDVERFY 162 S DA(1)=$O(^ORD(101,"B","GMPL PROBLEM LIST",0)) Q:'DA(1) 163 S VERFY=$O(^ORD(101,"B","GMPL VERIFY",0)) W "." 164 S DA=$O(^ORD(101,DA(1),10,"B",VERFY,0)) Q:'DA 165 S DR=$S(OLDVERFY:"2///@;6///^S X=BLANK",1:"2////$;6///@") W "." 166 S DIE="^ORD(101,"_DA(1)_",10," 167 D ^DIE W "." 168 Q 169 RS(X) ; Remove Slashes 170 S X=$G(X) F Q:$E(X,1)'="/" S X=$E(X,2,$L(X)) 171 F Q:$E(X,$L(X))'="/" S X=$E(X,1,($L(X)-1)) 172 Q X 1 GMPLX1 ; SLC/MKB/KER -- Problem List Person Utilities ; 04/15/2002 2 ;;2.0;Problem List;**3,26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 348 ^DPT( 6 ; DBIA 3106 ^DIC(49 7 ; DBIA 872 ^ORD(101 8 ; DBIA 10060 ^VA(200 9 ; DBIA 10062 7^VADPT 10 ; DBIA 10062 DEM^VADPT 11 ; DBIA 2716 $$GETSTAT^DGMSTAPI 12 ; DBIA 3457 $$GETCUR^DGNTAPI 13 ; DBIA 10104 $$REPEAT^XLFSTR 14 ; DBIA 10006 ^DIC 15 ; DBIA 10018 ^DIE 16 ; DBIA 10026 ^DIR 17 ; 18 PAT() ; Select patient -- returns DFN^NAME^BID 19 N DIC,X,Y,DFN,VADM,VA,PAT 20 P1 S DIC="^AUPNPAT(",DIC(0)="AEQM" D ^DIC I +Y<1 Q -1 21 I $P(Y,U,2)'=$P(^DPT(+Y,0),U) W $C(7),!!,"ERROR -- Please check your Patient Files #2 and #9000001 for inconsistencies.",! G P1 22 S DFN=+Y,PAT=Y D DEM^VADPT 23 S PAT=PAT_U_$E($P(PAT,U,2))_VA("BID"),AUPNSEX=$P(VADM(5),U) 24 I VADM(6) S PAT=PAT_U_+VADM(6) ; date of death 25 Q PAT 26 ; 27 VADPT(DFN) ; Get Service/Elig Flags 28 ; 29 ; Returns = 1/0/"" if Y/N/unknown 30 ; GMPSC Service Connected 31 ; GMPAGTOR Agent Orange Exposure 32 ; GMPION Ionizing Radiation Exposure 33 ; GMPGULF Persian Gulf Exposure 34 ; GMPMST Military Sexual Trauma 35 ; GMPHNC Head and/or Neck Cancer 36 ; 37 N VAEL,VASV,VAERR,HNC,X D 7^VADPT S GMPSC=VAEL(3),GMPAGTOR=VASV(2) 38 S GMPION=VASV(3),X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"") 39 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"") 40 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),GMPHNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 41 Q 42 SCS(PROB,SC) ; Get Exposure/Conditions Strings 43 ; 44 ; Input PROB Pointer to Problem #9000011 45 ; 46 ; Returns SC Array passed by reference 47 ; SC(1)="AO/IR/EC/HNC/MST" 48 ; SC(2)="A/I/E/H/M" 49 ; SC(3)="AIEHM" 50 ; 51 ; NOTE: Military Sexual Trauma (MST) is suppressed 52 ; if the current device is a printer. 53 ; 54 N ND,DA,FL,AO,IR,EC,HNC,MST,PTR S DA=+($G(PROB)) Q:+DA=0 55 S ND=$G(^AUPNPROB(+DA,1)),AO=+($P(ND,"^",11)),IR=+($P(ND,"^",12)) 56 S EC=+($P(ND,"^",13)),HNC=+($P(ND,"^",15)),MST=+($P(ND,"^",16)) 57 S PTR=$$PTR^GMPLUTL4 58 I +AO>0 D 59 . S:$G(SC(1))'["AO" SC(1)=$G(SC(1))_"/AO" S:$G(SC(2))'["A" SC(2)=$G(SC(2))_"/A" S:$G(SC(3))'["A" SC(3)=$G(SC(3))_"A" 60 I +IR>0 D 61 . S:$G(SC(1))'["IR" SC(1)=$G(SC(1))_"/IR" S:$G(SC(2))'["I" SC(2)=$G(SC(2))_"/I" S:$G(SC(3))'["I" SC(3)=$G(SC(3))_"I" 62 I +EC>0 D 63 . S:$G(SC(1))'["EC" SC(1)=$G(SC(1))_"/EC" S:$G(SC(2))'["E" SC(2)=$G(SC(2))_"/E" S:$G(SC(3))'["E" SC(3)=$G(SC(3))_"E" 64 I +HNC>0 D 65 . S:$G(SC(1))'["HNC" SC(1)=$G(SC(1))_"/HNC" S:$G(SC(2))'["H" SC(2)=$G(SC(2))_"/H" S:$G(SC(3))'["H" SC(3)=$G(SC(3))_"H" 66 I +PTR'>0 D 67 . I +MST>0 S:$G(SC(1))'["MST" SC(1)=$G(SC(1))_"/MST" S:$G(SC(2))'["M" SC(2)=$G(SC(2))_"/M" S:$G(SC(3))'["M" SC(3)=$G(SC(3))_"M" 68 S:$D(SC(1)) SC(1)=$$RS(SC(1)) S:$D(SC(2)) SC(2)=$$RS(SC(2)) 69 Q 70 SCCOND(DFN,SC) ; Get Service/Elig Flags (array) 71 ; Returns local array .SC passed by value 72 N HNC,VAEL,VASV,VAERR,X D 7^VADPT 73 S SC("DFN")=$G(DFN),SC("SC")=$P(VAEL(3),"^",1) 74 S SC("AO")=$P(VASV(2),"^",1) 75 S SC("IR")=$P(VASV(3),"^",1) 76 S X=$P($G(^DPT(DFN,.322)),U,10),SC("PG")=$S(X="Y":1,X="N":0,1:"") 77 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),SC("MST")=$S(X="Y":1,X="N":0,1:"") 78 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),SC("HNC")=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 79 Q 80 ; 81 CKDEAD(DATE) ; Dead patient ... continue? Returns 1 if YES, 0 otherwise 82 N DIR,X,Y S DIR(0)="YA",DIR("B")="NO" 83 S DIR("A")="Are you sure you want to continue? " 84 S DIR("?",1)=" Enter YES to continue and add new problem(s) for this patient:",DIR("?")=" press <return> to select another action." 85 W $C(7),!!,"DATE OF DEATH: "_$$EXTDT^GMPLX(DATE) 86 D ^DIR 87 Q +Y 88 ; 89 REQPROV() ; Returns requesting provider 90 N DIR,X,Y 91 I $D(GMPLUSER) S Y=DUZ_U_$P(^VA(200,DUZ,0),U) Q Y 92 S DIR("?")="Enter the name of the provider responsible for this data." 93 S DIR(0)="PA^200:AEQM",DIR("A")="Provider: " 94 S:$G(GMPROV) DIR("B")=$P(GMPROV,U,2) W ! D ^DIR 95 I $D(DUOUT)!($D(DTOUT))!(+Y'>0) Q -1 96 Q Y 97 ; 98 NAME(USER) ; Formats user name into "Lastname,F" 99 N NAME,LAST,FIRST 100 S NAME=$P($G(^VA(200,+USER,0)),U) I '$L(NAME) Q "" 101 S LAST=$P(NAME,","),FIRST=$P(NAME,",",2) 102 S:$E(FIRST)=" " FIRST=$E(FIRST,2,99) 103 Q $E(LAST,1,15)_","_$E(FIRST) 104 ; 105 SERVICE(USER) ; Returns User's service/section from file #49 106 N X S X=+$P($G(^VA(200,USER,5)),U) 107 I $P($G(^DIC(49,X,0)),U,9)'="C" S X=0 108 S:X>0 X=X_U_$P($G(^DIC(49,X,0)),U) S:X'>0 X="" 109 Q X 110 ; 111 SERV(X) ; Return service name abbreviation 112 N NODE,ABBREV 113 S NODE=$G(^DIC(49,+X,0)) I NODE="" Q "" 114 S ABBREV=$P(NODE,U,2) I ABBREV="" S ABBREV=$E($P(NODE,U),1,4) 115 Q ABBREV_"/" 116 ; 117 CLINIC(LAST) ; Returns clinic from file #44 118 N X,Y,DIC,DIR S Y="" G:$E(GMPLVIEW("VIEW"))="S" CLINQ 119 S DIR(0)="FAO^1:30",DIR("A")="Clinic: " S:$L(LAST) DIR("B")=$P(LAST,U,2) 120 S DIR("?")="Enter the clinic to be associated with these problems, if available" 121 S DIR("??")="^D LISTCLIN^GMPLMGR1 W !,DIR(""?"")_"".""" 122 CLIN1 ; Ask Clinic 123 D ^DIR S:$D(DUOUT)!($D(DTOUT)) Y="^" S:Y="@" Y="" G:("^"[Y) CLINQ 124 S DIC="^SC(",DIC(0)="EMQ",DIC("S")="I $P(^(0),U,3)=""C""" 125 D ^DIC I Y'>0 W !?5,"Only clinics are allowed!",! G CLIN1 126 CLINQ ; Quit Asking 127 Q Y 128 ; 129 VIEW(USER) ; Returns user's preferred view 130 N X S X=$P($G(^VA(200,USER,125)),U) 131 Q X 132 ; 133 VOCAB() ; Select search vocabulary 134 N DIR,X,Y S DIR(0)="SAOM^N:NURSING;I:IMMUNOLOGIC;D:DENTAL;S:SOCIAL WORK;P:GENERAL PROBLEM" 135 S DIR("A")="Select Specialty Subset: ",DIR("B")="GENERAL PROBLEM" 136 S DIR("?",1)="Because many discipline-specific terms are synonyms to other terms," 137 S DIR("?",2)="they are not accessible unless you specify the appropriate subset of the" 138 S DIR("?",3)="Clinical Lexicon to select from. Choose from: Nursing" 139 S DIR("?",4)=$$REPEAT^XLFSTR(" ",48)_"Immunologic" 140 S DIR("?",5)=$$REPEAT^XLFSTR(" ",48)_"Dental" 141 S DIR("?",6)=$$REPEAT^XLFSTR(" ",48)_"Social Work" 142 S DIR("?")=$$REPEAT^XLFSTR(" ",48)_"General Problem" 143 D ^DIR S X=$S(Y="N":"NUR",Y="I":"IMM",Y="D":"DEN",Y="S":"SOC",Y="P":"PL1",1:"^") 144 Q X 145 ; 146 PARAMS ; Edit pkg parameters in file #125.99 147 N DIE,DA,DR,OLDVERFY,VERFY,BLANK S BLANK=" " 148 S OLDVERFY=+$P($G(^GMPL(125.99,1,0)),U,2) 149 S DIE="^GMPL(125.99,",DA=1,DR="1:6" D ^DIE 150 Q:+$P($G(^GMPL(125.99,1,0)),U,2)=OLDVERFY 151 S DA(1)=$O(^ORD(101,"B","GMPL PROBLEM LIST",0)) Q:'DA(1) 152 S VERFY=$O(^ORD(101,"B","GMPL VERIFY",0)) W "." 153 S DA=$O(^ORD(101,DA(1),10,"B",VERFY,0)) Q:'DA 154 S DR=$S(OLDVERFY:"2///@;6///^S X=BLANK",1:"2////$;6///@") W "." 155 S DIE="^ORD(101,"_DA(1)_",10," 156 D ^DIE W "." 157 Q 158 RS(X) ; Remove Slashes 159 S X=$G(X) F Q:$E(X,1)'="/" S X=$E(X,2,$L(X)) 160 F Q:$E(X,$L(X))'="/" S X=$E(X,1,($L(X)-1)) 161 Q X
Note:
See TracChangeset
for help on using the changeset viewer.
