Changeset 623 for WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLENFM.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLENFM.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLENFM.m
r613 r623 1 GMPLENFM ; SLC/MKB/KER -- Problem List Enc Form utilities ; 04/15/2002 2 ;;2.0;Problem List;**3,4,7,26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 10082 ^ICD9( 6 ; DBIA 10006 ^DIC 7 ; DBIA 1609 CONFIG^LEXSET 8 ; 9 ACTIVE ; List of Active Problems for DFN 10 ; Sets Global Array: 11 ; ^TMP("IB",$J,"INTERFACES",DFN,"GMP PATIENT ACTIVE PROBLEMS",#) = 12 ; 13 ; Piece 1: Problem text 14 ; 2: ICD code 15 ; 3: Date of Onset 00/00/00 format 16 ; 4: SC/NSC/"" serv-conn/not sc/unknown 17 ; 5: Y/N/"" serv-conn/not sc/unknown 18 ; 6: A/I/E/H/M/C/S/"" If problem is flagged as: 19 ; A - Agent Orange 20 ; I - Ionizing Radiation 21 ; E - Environmental Contaminants 22 ; H - Head/Neck Cancer 23 ; M - Mil Sexual Trauma 24 ; C - Combat Vet 25 ; S - SHAD 26 ; - None 27 ; 7: Special Exposure Full text of piece 6 28 ; 29 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL 30 N GMPDFN,NODE 31 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0)) 32 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1 33 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 34 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 35 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 36 . S IFN=GMPLIST(NUM) Q:IFN'>0 37 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 38 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1 39 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB 40 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U) 41 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10) 42 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^") 43 . S PROB=PROB_U_$$GMPL1 44 . ;S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"I^Ionizing Radiation",$P(GMPL1,U,13):"E^Env. Contaminants" 45 . ;,$P(GMPL1,U,13):"H^Head/Neck Cancer",$P(GMPL1,U,16):"M^Mil Sexual Trauma",$P(GMPL1,U,17):"C^Combat Vet",$P(GMPL1,U,18):"S^SHAD",1:"^") 46 . S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",CNT)=PROB 47 S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",0)=CNT 48 Q 49 ; 50 SELECT ; Select Common Problems 51 ; Sets Global Array: 52 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS") 53 ; Piece 1: Pointer to Clinical Lexicon 54 ; 2: Problem Text 55 ; 3: ICD Code (null if unknown) 56 ; 57 N X,Y,DIC,PROB D CONFIG^LEXSET("ICD","ICD") 58 K ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS") 59 S DIC("A")="Select PROBLEM: ",DIC(0)="AEQM",DIC="^LEX(757.01," 60 D ^DIC Q:+Y<0 S PROB=Y I +Y'>1 S PROB=+Y_U_X 61 S PROB=PROB_U_$G(Y(1)) 62 S ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")=PROB 63 Q 64 ; 65 DSELECT ; List of Active Problems for DFN 66 ; Sets Global Array" 67 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",#) = 68 ; 69 ; Piece 1: Problem IEN 70 ; 2: Problem Text 71 ; 3: ICD code 72 ; 4: Date of Onset 00/00/00 format 73 ; 5: SC/NSC/"" serv-conn/not sc/unknown 74 ; 6: Y/N/"" serv-conn/not sc/unknown 75 ; 7: A/I/E/H/M/C/S/"" If problem is flagged as: 76 ; A - Agent Orange 77 ; I - Ionizing Radiation 78 ; E - Environmental Contaminants 79 ; H - Head/Neck Cancer 80 ; M - Mil Sexual Trauma 81 ; C - Combat Vet 82 ; S - SHAD 83 ; - None 84 ; 8: Special Exposure Full text of piece 6 85 ; 86 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE 87 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0)) 88 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1 89 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 90 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 91 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 92 . S IFN=GMPLIST(NUM) Q:IFN'>0 93 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 94 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1 95 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB 96 . S PROB=IFN_U_PROB 97 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U) 98 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10) 99 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^") 100 . S PROB=PROB_U_$$GMPL1 101 . ;S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"I^Radiation",$P(GMPL1,U,13):"E^Contaminants",$P(GMPL1,U,13):"H^Head/Neck Cancer" 102 . ;,$P(GMPL1,U,16):"M^Mil Sexual Trauma",$P(GMPL1,U,17):"C^Combat Vet",$P(GMPL1,U,18):"S^SHAD",1:"^") 103 . S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",CNT)=PROB 104 S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=CNT 105 Q 106 ; 107 GMPL1() ;Determine Treatment Factor, if any 108 N NXTTF,TXFACTOR 109 S TXFACTOR="^" 110 F NXTTF=11,12,13,15,16,17,18 I $P(GMPL1,U,NXTTF) S TXFACTOR=$P("A^Agent Orange;I^Ionizing Radiation;E^Env. Contaminants;;H^Head/Neck Cancer;M^Mil Sexual Trauma;C^Combat Vet;S^SHAD",";",NXTTF-10) Q 111 Q TXFACTOR 1 GMPLENFM ; SLC/MKB/KER -- Problem List Enc Form utilities ; 04/15/2002 2 ;;2.0;Problem List;**3,4,7,26**;Aug 25, 1994;Build 1 3 ; 4 ; External References 5 ; DBIA 10082 ^ICD9( 6 ; DBIA 10006 ^DIC 7 ; DBIA 1609 CONFIG^LEXSET 8 ; 9 ACTIVE ; List of Active Problems for DFN 10 ; Sets Global Array: 11 ; ^TMP("IB",$J,"INTERFACES",DFN,"GMP PATIENT ACTIVE PROBLEMS",#) = 12 ; 13 ; Piece 1: Problem text 14 ; 2: ICD code 15 ; 3: Date of Onset 00/00/00 format 16 ; 4: SC/NSC/"" serv-conn/not sc/unknown 17 ; 5: Y/N/"" serv-conn/not sc/unknown 18 ; 6: A/R/C/H/M/"" If problem is flagged as: 19 ; A - Agent Orange 20 ; R - Radiation 21 ; C - Contaminants 22 ; H - Head/Neck Cancer 23 ; M - Mil Sexual Trauma 24 ; - None 25 ; 7: Special Exposure Full text of piece 6 26 ; 27 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL 28 N GMPDFN,NODE 29 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0)) 30 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1 31 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 32 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 33 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 34 . S IFN=GMPLIST(NUM) Q:IFN'>0 35 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 36 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1 37 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB 38 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U) 39 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10) 40 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^") 41 . S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"R^Radiation",$P(GMPL1,U,13):"C^Contaminants",$P(GMPL1,U,13):"H^Head/Neck Cancer",$P(GMPL1,U,16):"M^Mil Sexual Trauma",1:"^") 42 . S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",CNT)=PROB 43 S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",0)=CNT 44 Q 45 ; 46 SELECT ; Select Common Problems 47 ; Sets Global Array: 48 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS") 49 ; Piece 1: Pointer to Clinical Lexicon 50 ; 2: Problem Text 51 ; 3: ICD Code (null if unknown) 52 ; 53 N X,Y,DIC,PROB D CONFIG^LEXSET("ICD","ICD") 54 K ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS") 55 S DIC("A")="Select PROBLEM: ",DIC(0)="AEQM",DIC="^LEX(757.01," 56 D ^DIC Q:+Y<0 S PROB=Y I +Y'>1 S PROB=+Y_U_X 57 S PROB=PROB_U_$G(Y(1)) 58 S ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")=PROB 59 Q 60 ; 61 DSELECT ; List of Active Problems for DFN 62 ; Sets Global Array" 63 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",#) = 64 ; 65 ; Piece 1: Problem IEN 66 ; 2: Problem Text 67 ; 3: ICD code 68 ; 4: Date of Onset 00/00/00 format 69 ; 5: SC/NSC/"" serv-conn/not sc/unknown 70 ; 6: Y/N/"" serv-conn/not sc/unknown 71 ; 7: A/R/C/H/M/"" If problem is flagged as: 72 ; A - Agent Orange 73 ; R - Radiation 74 ; C - Contaminants 75 ; H - Head/Neck Cancer 76 ; M - Mil Sexual Trauma 77 ; - None 78 ; 8: Special Exposure Full text of piece 6 79 ; 80 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE 81 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0)) 82 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1 83 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 84 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 85 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 86 . S IFN=GMPLIST(NUM) Q:IFN'>0 87 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 88 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1 89 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB 90 . S PROB=IFN_U_PROB 91 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U) 92 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10) 93 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^") 94 . S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"R^Radiation",$P(GMPL1,U,13):"C^Contaminants",$P(GMPL1,U,13):"H^Head/Neck Cancer",$P(GMPL1,U,16):"M^Mil Sexual Trauma",1:"^") 95 . S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",CNT)=PROB 96 S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=CNT 97 Q
Note:
See TracChangeset
for help on using the changeset viewer.
