Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSTA2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSTA2.m
r613 r623 1 PXRMSTA2 ; SLC/AGP - Routines for building status list. ;03/27/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 DATA(FILE,DA,TYPE,RXTYPE,STATUS) ; 5 ; this sub routine get the list of statuses from the apporiate global 6 ; 7 N ARRAY,ARRAY1,CNT,CODE,DEF,OUTPUT,SARRAY,STAT 8 LOOP ; 9 ;get build status list into a local array from each pharmacy type of 10 ;finding item 11 I TYPE="DRUG" D 12 .I $D(RXTYPE("I"))>0 D 13 . . D STATUS^PSS55MIS(55.06,28,"SARRAY") 14 . . ;D FIELD^DID(55.06,28,"","POINTER","SARRAY") 15 . . D ARRAYFOR(.SARRAY,.ARRAY,"I") K CODE 16 . . D STATUS^PSS55MIS(55.01,100,"SARRAY") 17 . . ;D FIELD^DID(55.01,100,"","POINTER","SARRAY") 18 . . D ARRAYFOR(.SARRAY,.ARRAY1,"I") K CODE 19 . . D COMPARE(.ARRAY,.ARRAY1,"I",.OUTPUT) 20 . I $D(RXTYPE("O"))>0 D 21 . . K ARRAY,ARRAY1,CODE 22 . . D STATUS^PSODI(52,100,"SARRAY") 23 . . ;D FIELD^DID(52,100,"","POINTER","SARRAY") 24 . . D ARRAYFOR(.SARRAY,.ARRAY,"O") K CODE 25 . . I $D(OUTPUT)>0 K ARRAY1 M ARRAY1=OUTPUT K OUTPUT D COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT) 26 . . E M OUTPUT=ARRAY 27 . I $D(RXTYPE("N"))>0 D 28 . . K ARRAY,ARRAY1,CODE 29 . . D STATUS^PSS55MIS(55.05,5,"SARRAY") 30 . . ;D FIELD^DID(55.05,5,"","POINTER","SARRAY") 31 . . S SARRAY("POINTER")=SARRAY("POINTER")_"0:ACTIVE;" 32 . . D ARRAYFOR(.SARRAY,.ARRAY,"N") K CODE 33 . . I $D(OUTPUT)>0 K ARRAY1 M ARRAY1=OUTPUT K OUTPUT D COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT) 34 . . E M OUTPUT=ARRAY 35 ; 36 I TYPE="PROB" S OUTPUT("ACTIVE")="ACTIVE",OUTPUT("INACTIVE")="INACTIVE" 37 I TYPE="ORD(101.43," D 38 . S CNT=0,STAT="" F S STAT=$O(^ORD(100.01,"B",STAT)) Q:STAT="" D 39 . . S CNT=CNT+1 S OUTPUT(STAT)=STAT 40 I TYPE="RAMIS(71,"!(TYPE="TAX") D 41 . S TYPE="RAMIS(71," 42 . S CNT=0,STAT="" F S STAT=$O(^RA(72,"B",STAT)) Q:STAT="" D 43 . . S CNT=CNT+1 S OUTPUT(STAT)=STAT 44 .;I TYPE'="TAX" Q 45 .;I '$D(OUTPUT("ACTIVE")) S OUTPUT("ACTIVE")="ACTIVE" 46 .;I '$D(OUTPUT("INACTIVE")) S OUTPUT("INACTIVE")="INACTIVE" 47 D SELECT(.OUTPUT,FILE,TYPE,.STATUS,.DA) 48 ; 49 Q 50 ; 51 COMPARE(ARRAY,ARRAY1,TYPE,OUTPUT) ; 52 ; this sub routine is use to combine the InPatient and 53 ; Both Pharmacy type into one array 54 N ARY,CNT,COMP,NODE 55 K OUTPUT 56 S COMP="" 57 ; 58 ;inpatient pharmacy list is built from two seperated fields in file #55 59 ;this is used to combined the two fields into one array 60 I $G(TYPE)="I" D 61 . F S COMP=$O(ARRAY(COMP)) Q:COMP="" D 62 . . S OUTPUT(COMP)=ARRAY(COMP) 63 . S (COMP)="" F S COMP=$O(ARRAY1(COMP)) Q:COMP="" D 64 . . I '$D(OUTPUT(COMP)) S OUTPUT(COMP)=ARRAY1(COMP) 65 ; 66 ;this section is uses to combine the different RX Types into one array 67 I $G(TYPE)'="I" D 68 . F S COMP=$O(ARRAY(COMP)) Q:COMP="" D 69 . . S NODE=$G(ARRAY(COMP)) 70 . . S OUTPUT(COMP)=NODE 71 . S COMP="" F S COMP=$O(ARRAY1(COMP)) Q:COMP="" D 72 . . S NODE=$G(ARRAY1(COMP)) 73 . . I '$D(OUTPUT(COMP)) S OUTPUT(COMP)=NODE Q 74 . . I $D(OUTPUT(COMP)) S $P(OUTPUT(COMP),U,2)=$P(OUTPUT(COMP),U,2)_$P(NODE,U,2) 75 Q 76 ; 77 ARRAYFOR(ARRAY,OUTPUT,DEF) ; 78 ;this sub routine is use to format the array data into a standard 79 ;format 80 ; 81 N CNT,COMP,PIECE,STR,TYPE 82 S PIECE=0 83 ; 84 ;determine the number of pieces minus one in the string 85 F CNT=1:1:$L(ARRAY("POINTER")) I $E(ARRAY("POINTER"),CNT)=";" S PIECE=PIECE+1 I PIECE>0 D 86 . S STR=$P($P($G(ARRAY("POINTER")),";",PIECE),":",2) 87 . S OUTPUT($P($P($G(ARRAY("POINTER")),";",PIECE),":",2))=STR_U_$G(DEF) 88 ; 89 ;add last piece in the string to the array 90 I PIECE>0 S PIECE=PIECE+1 D 91 . I $P($G(ARRAY("POINTER")),";",PIECE)'="" D 92 . . S OUTPUT($P($P($G(ARRAY("POINTER")),";",PIECE),":",2))=$P($P($G(ARRAY("POINTER")),";",PIECE),":",2)_U_$G(DEF) 93 Q 94 ; 95 SELECT(ARRAY,FILE,TYPE,STATUS,DA) ; 96 ; this sub routine is use to sort through the formated array and 97 ; set up the DIR call 98 ; 99 N CHECK,CNT,CNT1,DIR,DUOUT,DTOUT,EMPTY,EXTR 100 N HELP,LENGTH,NODE,STAT,STR,TEXT,TMP,X,Y 101 N TMPARR,NUM 102 DISPLAY ; 103 I TYPE="DRUG" S TEXT="Select a Medication Status or enter '^' to Quit",HELP="Select a status from the Medication Status list or '^' to Quit" 104 I TYPE="ORD(101.43," S TEXT="Select a Order Status from or enter '^' to Quit",HELP="Select a Order Status from the status list or '^' to Quit" 105 I TYPE="RAMIS(71," S TEXT="Select a Radiology Procedure Status or enter '^' to Quit",HELP="Select a Radiology Procedure Status from the status list or '^' to Quit" 106 ;I TYPE="TAX" S TEXT="Select a Taxonomy Status or enter '^' to Quit",HELP="Select a Taxonomy Status from the status list or '^' to Quit" 107 ;I TYPE="PROB" S TEXT="Select a Problem Status or enter '^' to Quit",HELP="Select a Taxonomy Status from the status list or '^' to Quit" 108 ; 109 S CNT=0,CNT1=0,STAT="" 110 ;if text is not entered into the prompt or no match is found display 111 ;entire list of statuses for this finding item 112 ; 113 ;Add wildcard character 114 S CNT=CNT+1,CNT1=CNT1+1,TMP(CNT)=CNT_" - * (WildCard)",TMPARR(CNT)="*" 115 ;Add status from file to the selectable list 116 F S STAT=$O(ARRAY(STAT)) Q:STAT="" D 117 . S NODE=$G(ARRAY(STAT)) 118 . S STR=$P(NODE,U) 119 . S CNT=CNT+1,CNT1=CNT1+1 120 . I TYPE="DRUG" S TMP(CNT)=CNT_" - "_STR_"("_$P(NODE,U,2)_")",TMPARR(CNT)=STR 121 . E S TMP(CNT)=CNT_" - "_STR,TMPARR(CNT)=STR 122 ; 123 S DIR(0)="LO^1:"_CNT_"" 124 M DIR("A")=TMP 125 S DIR("A")=TEXT 126 S DIR("?")=HELP 127 D ^DIR 128 I $D(DTOUT)!($D(DUOUT))!($G(Y)="") K STATUS Q 129 S CNT=0 F X=1:1:$L(Y(0)) D 130 .I $E(Y(0),X)="," S CNT=CNT+1,NUM=$P(Y(0),",",CNT),STATUS(TMPARR(NUM))="" 131 ;S STATUS=Y(0) 132 ;I STATUS="WildCard" S STATUS="*" 133 Q 134 ; 1 PXRMSTA2 ; SLC/AGP - Routines for building status list. ;9/26/2005 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 DATA(FILE,DA,TYPE,RXTYPE,STATUS) ; 5 ; this sub routine get the list of statuses from the apporiate global 6 ; 7 N ARRAY,ARRAY1,CNT,CODE,DEF,OUTPUT,SARRAY,STAT 8 LOOP ; 9 ;get build status list into a local array from each pharmacy type of 10 ;finding item 11 I TYPE="DRUG" D 12 .I $D(RXTYPE("I"))>0 D 13 . . D FIELD^DID(55.06,28,"","POINTER","SARRAY") 14 . . D ARRAYFOR(.SARRAY,.ARRAY,"I") K CODE 15 . . D FIELD^DID(55.01,100,"","POINTER","SARRAY") 16 . . D ARRAYFOR(.SARRAY,.ARRAY1,"I") K CODE 17 . . D COMPARE(.ARRAY,.ARRAY1,"I",.OUTPUT) 18 . I $D(RXTYPE("O"))>0 D 19 . . K ARRAY,ARRAY1,CODE 20 . . D FIELD^DID(52,100,"","POINTER","SARRAY") 21 . . D ARRAYFOR(.SARRAY,.ARRAY,"O") K CODE 22 . . I $D(OUTPUT)>0 K ARRAY1 M ARRAY1=OUTPUT K OUTPUT D COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT) 23 . . E M OUTPUT=ARRAY 24 . I $D(RXTYPE("N"))>0 D 25 . . K ARRAY,ARRAY1,CODE 26 . . D FIELD^DID(55.05,5,"","POINTER","SARRAY") 27 . . S SARRAY("POINTER")=SARRAY("POINTER")_"0:ACTIVE;" 28 . . D ARRAYFOR(.SARRAY,.ARRAY,"N") K CODE 29 . . I $D(OUTPUT)>0 K ARRAY1 M ARRAY1=OUTPUT K OUTPUT D COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT) 30 . . E M OUTPUT=ARRAY 31 ; 32 I TYPE="PROB" S OUTPUT("ACTIVE")="ACTIVE",OUTPUT("INACTIVE")="INACTIVE" 33 I TYPE="ORD(101.43," D 34 . S CNT=0,STAT="" F S STAT=$O(^ORD(100.01,"B",STAT)) Q:STAT="" D 35 . . S CNT=CNT+1 S OUTPUT(STAT)=STAT 36 I TYPE="RAMIS(71,"!(TYPE="TAX") D 37 . S TYPE="RAMIS(71," 38 . S CNT=0,STAT="" F S STAT=$O(^RA(72,"B",STAT)) Q:STAT="" D 39 . . S CNT=CNT+1 S OUTPUT(STAT)=STAT 40 .;I TYPE'="TAX" Q 41 .;I '$D(OUTPUT("ACTIVE")) S OUTPUT("ACTIVE")="ACTIVE" 42 .;I '$D(OUTPUT("INACTIVE")) S OUTPUT("INACTIVE")="INACTIVE" 43 D SELECT(.OUTPUT,FILE,TYPE,.STATUS,.DA) 44 ; 45 Q 46 ; 47 COMPARE(ARRAY,ARRAY1,TYPE,OUTPUT) ; 48 ; this sub routine is use to combine the InPatient and 49 ; Both Pharmacy type into one array 50 N ARY,CNT,COMP,NODE 51 K OUTPUT 52 S COMP="" 53 ; 54 ;inpatient pharmacy list is built from two seperated fields in file #55 55 ;this is used to combined the two fields into one array 56 I $G(TYPE)="I" D 57 . F S COMP=$O(ARRAY(COMP)) Q:COMP="" D 58 . . S OUTPUT(COMP)=ARRAY(COMP) 59 . S (COMP)="" F S COMP=$O(ARRAY1(COMP)) Q:COMP="" D 60 . . I '$D(OUTPUT(COMP)) S OUTPUT(COMP)=ARRAY1(COMP) 61 ; 62 ;this section is uses to combine the different RX Types into one array 63 I $G(TYPE)'="I" D 64 . F S COMP=$O(ARRAY(COMP)) Q:COMP="" D 65 . . S NODE=$G(ARRAY(COMP)) 66 . . S OUTPUT(COMP)=NODE 67 . S COMP="" F S COMP=$O(ARRAY1(COMP)) Q:COMP="" D 68 . . S NODE=$G(ARRAY1(COMP)) 69 . . I '$D(OUTPUT(COMP)) S OUTPUT(COMP)=NODE Q 70 . . I $D(OUTPUT(COMP)) S $P(OUTPUT(COMP),U,2)=$P(OUTPUT(COMP),U,2)_$P(NODE,U,2) 71 Q 72 ; 73 ARRAYFOR(ARRAY,OUTPUT,DEF) ; 74 ;this sub routine is use to format that array data into a standard 75 ;format 76 ; 77 N CNT,COMP,PIECE,STR,TYPE 78 S PIECE=0 79 ; 80 ;determine the number of pieces minus one in the string 81 F CNT=1:1:$L(ARRAY("POINTER")) I $E(ARRAY("POINTER"),CNT)=";" S PIECE=PIECE+1 I PIECE>0 D 82 . S STR=$P($P($G(ARRAY("POINTER")),";",PIECE),":",2) 83 . S OUTPUT($P($P($G(ARRAY("POINTER")),";",PIECE),":",2))=STR_U_$G(DEF) 84 ; 85 ;add last piece in the string to the array 86 I PIECE>0 S PIECE=PIECE+1 D 87 . I $P($G(ARRAY("POINTER")),";",PIECE)'="" D 88 . . S OUTPUT($P($P($G(ARRAY("POINTER")),";",PIECE),":",2))=$P($P($G(ARRAY("POINTER")),";",PIECE),":",2)_U_$G(DEF) 89 Q 90 ; 91 SELECT(ARRAY,FILE,TYPE,STATUS,DA) ; 92 ; this sub routine is use to sort through the formated array and 93 ; set up the DIR call 94 ; 95 N CHECK,CNT,CNT1,DIR,DUOUT,DTOUT,EMPTY,EXTR 96 N HELP,LENGTH,NODE,STAT,STR,TEXT,TMP,X,Y 97 N TMPARR,NUM 98 DISPLAY ; 99 I TYPE="DRUG" S TEXT="Select a Medication Status or enter '^' to Quit",HELP="Select a status from the Medication Status list or '^' to Quit" 100 I TYPE="ORD(101.43," S TEXT="Select a Order Status from or enter '^' to Quit",HELP="Select a Order Status from the status list or '^' to Quit" 101 I TYPE="RAMIS(71," S TEXT="Select a Radiology Procedure Status or enter '^' to Quit",HELP="Select a Radiology Procedure Status from the status list or '^' to Quit" 102 ;I TYPE="TAX" S TEXT="Select a Taxonomy Status or enter '^' to Quit",HELP="Select a Taxonomy Status from the status list or '^' to Quit" 103 ;I TYPE="PROB" S TEXT="Select a Problem Status or enter '^' to Quit",HELP="Select a Taxonomy Status from the status list or '^' to Quit" 104 ; 105 S CNT=0,CNT1=0,STAT="" 106 ;if text is not entered into the prompt or no match is found display 107 ;entire list of statuses for this finding item 108 ; 109 ;Add wildcard character 110 S CNT=CNT+1,CNT1=CNT1+1,TMP(CNT)=CNT_" - * (WildCard)",TMPARR(CNT)="*" 111 ;Add status from file to the selectable list 112 F S STAT=$O(ARRAY(STAT)) Q:STAT="" D 113 . S NODE=$G(ARRAY(STAT)) 114 . S STR=$P(NODE,U) 115 . S CNT=CNT+1,CNT1=CNT1+1 116 . I TYPE="DRUG" S TMP(CNT)=CNT_" - "_STR_"("_$P(NODE,U,2)_")",TMPARR(CNT)=STR 117 . E S TMP(CNT)=CNT_" - "_STR,TMPARR(CNT)=STR 118 ; 119 S DIR(0)="LO^1:"_CNT_"" 120 M DIR("A")=TMP 121 S DIR("A")=TEXT 122 S DIR("?")=HELP 123 D ^DIR 124 I $D(DTOUT)!($D(DUOUT))!($G(Y)="") K STATUS Q 125 S CNT=0 F X=1:1:$L(Y(0)) D 126 .I $E(Y(0),X)="," S CNT=CNT+1,NUM=$P(Y(0),",",CNT),STATUS(TMPARR(NUM))="" 127 ;S STATUS=Y(0) 128 ;I STATUS="WildCard" S STATUS="*" 129 Q 130 ;
Note:
See TracChangeset
for help on using the changeset viewer.
