| 1 | PXRMLPOE ; SLC/PJH - Build OE/RR Team from Patient List;07/08/2002
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|---|
| 3 | ;
|
|---|
| 4 | ; Called from PXRM PATIENT LIST OE/RR protocol
|
|---|
| 5 | ;
|
|---|
| 6 | OERR(IENO) ;Copy patient list to OE/RR Team
|
|---|
| 7 | ;
|
|---|
| 8 | ;Check if OK to copy
|
|---|
| 9 | D ASK(IENO,"Copy") Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 10 | ;
|
|---|
| 11 | N IENN,NNAME,ONAME,TEXT,X,Y
|
|---|
| 12 | ;
|
|---|
| 13 | ;Select OE/RR Team to copy to
|
|---|
| 14 | S TEXT="Select OE/RR TEAM name to copy to: "
|
|---|
| 15 | D OTEAM(.IENN,.NNAME,TEXT) Q:$D(DUOUT)!$D(DTOUT) Q:'IENN
|
|---|
| 16 | ;
|
|---|
| 17 | S ONAME=$P($G(^PXRMXP(810.5,IENO,0)),U)
|
|---|
| 18 | ;
|
|---|
| 19 | ;Load list into ^TMP
|
|---|
| 20 | D LOAD("PXRMRULE",IENO)
|
|---|
| 21 | ;Update OE/RR Team list
|
|---|
| 22 | D UPDLST("PXRMRULE",IENN,NNAME)
|
|---|
| 23 | ;
|
|---|
| 24 | W !!,"Completed copy of patient list '"_ONAME_"'"
|
|---|
| 25 | W !,"into OE/RR Team '"_NNAME_"'",! H 4
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | OK ;Option to overwrite existing list
|
|---|
| 29 | N X,Y,TEXT
|
|---|
| 30 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 31 | S DIR(0)="YA0"
|
|---|
| 32 | S DIR("A")="Overwrite existing OE/RR Team list: "
|
|---|
| 33 | S DIR("B")="N"
|
|---|
| 34 | S DIR("?")="Enter Y or N. For detailed help type ??"
|
|---|
| 35 | S DIR("??")=U_"D HELP^PXRMLCR(1)"
|
|---|
| 36 | W !
|
|---|
| 37 | D ^DIR K DIR
|
|---|
| 38 | I $D(DIROUT) S DTOUT=1
|
|---|
| 39 | I $D(DTOUT)!($D(DUOUT)) Q
|
|---|
| 40 | I $E(Y(0))="N" S DUOUT=1 Q
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | ASK(PLIEN,OPT) ;Verify patient list name
|
|---|
| 44 | N X,Y,TEXT
|
|---|
| 45 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 46 | S DIR(0)="YA0"
|
|---|
| 47 | S DIR("A")=OPT_" patient list "_$P($G(^PXRMXP(810.5,PLIEN,0)),U)_"?: "
|
|---|
| 48 | S DIR("B")="N"
|
|---|
| 49 | S DIR("?")="Enter Y or N. For detailed help type ??"
|
|---|
| 50 | W !
|
|---|
| 51 | D ^DIR K DIR
|
|---|
| 52 | I $D(DIROUT) S DTOUT=1
|
|---|
| 53 | I $D(DTOUT)!($D(DUOUT)) Q
|
|---|
| 54 | I $E(Y(0))="N" S DUOUT=1 Q
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | ;
|
|---|
| 58 | LOAD(NODE,LIST) ;Load Patient List
|
|---|
| 59 | N DFN,INC,SUB
|
|---|
| 60 | S SUB=0,INC=0
|
|---|
| 61 | K ^TMP(NODE,$J)
|
|---|
| 62 | F S SUB=$O(^PXRMXP(810.5,LIST,30,SUB)) Q:'SUB D
|
|---|
| 63 | .S DFN=$P($G(^PXRMXP(810.5,LIST,30,SUB,0)),U) Q:'DFN
|
|---|
| 64 | .S INC=INC+1,^TMP(NODE,$J,INC)=DFN
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | OTEAM(LIST,NAME,TEXT) ;Select OERR/Team
|
|---|
| 68 | N X,Y,DIC,DIE,DR,DLAYGO
|
|---|
| 69 | W !
|
|---|
| 70 | W !,"To overwrite an existing list you must be the creator of the list and"
|
|---|
| 71 | W !,"the OE/RR team list must be defined as a Team List."
|
|---|
| 72 | OT1 S DIC=100.21,DLAYGO=DIC,DIC(0)="QAEMZL"
|
|---|
| 73 | S DIC("S")="I $P($G(^(0)),U,2)=""TM"",$P($G(^(0)),U,5)=DUZ"
|
|---|
| 74 | S DIC("A")=TEXT
|
|---|
| 75 | W !
|
|---|
| 76 | D ^DIC
|
|---|
| 77 | I X="" W !,"An OE/RR Team name must be entered" G OT1
|
|---|
| 78 | I X=(U_U) S DTOUT=1
|
|---|
| 79 | I Y=-1 S DUOUT=1
|
|---|
| 80 | I $D(DTOUT)!$D(DUOUT) Q
|
|---|
| 81 | ;
|
|---|
| 82 | ;Check if OK to overwrite
|
|---|
| 83 | I $P(Y,U,3)'=1 D Q:$D(DTOUT) G:$D(DUOUT) OT1
|
|---|
| 84 | .D OK
|
|---|
| 85 | ;Return list ien
|
|---|
| 86 | S LIST=$P(Y,U),NAME=$P(Y,U,2)
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | UPDLST(NODE,LIST,NAME) ;Update patient list
|
|---|
| 90 | N CNT,DA,DFN,DIK,DUOUT,FDA,MSG,SUB,TEMP
|
|---|
| 91 | ;Lock patient list
|
|---|
| 92 | D LOCK Q:$D(DUOUT)
|
|---|
| 93 | ;
|
|---|
| 94 | ;Clear existing list
|
|---|
| 95 | S SUB=0
|
|---|
| 96 | F S SUB=$O(^OR(100.21,LIST,10,SUB)) Q:'SUB D
|
|---|
| 97 | .S DA=SUB,DA(1)=LIST,DIK="^OR(100.21,"_DA(1)_",10,"
|
|---|
| 98 | .D ^DIK
|
|---|
| 99 | ;
|
|---|
| 100 | ;DBIA #4561 putting data into OE/RR list
|
|---|
| 101 | ;Merge ^TMP into Patient List
|
|---|
| 102 | W !,"Updating "_NAME
|
|---|
| 103 | S DFN=0,CNT=1
|
|---|
| 104 | F S DFN=$O(^TMP(NODE,$J,DFN)) Q:'DFN D
|
|---|
| 105 | .S CNT=CNT+1
|
|---|
| 106 | .S ^TMP("PXRMFDA",$J,100.2101,"?+"_CNT_",?1,",.01)=$G(^TMP(NODE,$J,DFN))_";DPT("
|
|---|
| 107 | ;Update
|
|---|
| 108 | S ^TMP("PXRMFDA",$J,100.21,"?1,",.01)=NAME
|
|---|
| 109 | S ^TMP("PXRMFDA",$J,100.21,"?1,",.1)=$$UP^XLFSTR(NAME)
|
|---|
| 110 | S ^TMP("PXRMFDA",$J,100.21,"?1,",1)="TM"
|
|---|
| 111 | S ^TMP("PXRMFDA",$J,100.21,"?1,",1.6)=DUZ
|
|---|
| 112 | S ^TMP("PXRMFDA",$J,100.21,"?1,",1.65)=$$NOW^XLFDT
|
|---|
| 113 | S TEMP="^TMP(""PXRMFDA"","_$J_")"
|
|---|
| 114 | D UPDATE^DIE("",TEMP,"","MSG")
|
|---|
| 115 | ;Error
|
|---|
| 116 | I $D(MSG) D ERR
|
|---|
| 117 | ;Unlock patient list
|
|---|
| 118 | D UNLOCK
|
|---|
| 119 | K ^TMP(NODE,$J)
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | ;File locking
|
|---|
| 123 | UNLOCK L -^PXRMXP(100.21,LIST) Q
|
|---|
| 124 | LOCK L +^PXRMXP(100.21,LIST):0
|
|---|
| 125 | E W !!?5,"Another user is using this OE/RR team list" S DUOUT=1
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
| 128 | ERR ;Error Handler
|
|---|
| 129 | N ERROR,IC,REF
|
|---|
| 130 | S ERROR(1)="Unable to build patient list : "
|
|---|
| 131 | S ERROR(2)=NAME
|
|---|
| 132 | S ERROR(3)="Error in UPDATE^DIE, needs further investigation"
|
|---|
| 133 | ;Move MSG into ERROR
|
|---|
| 134 | S REF="MSG"
|
|---|
| 135 | F IC=4:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
|
|---|
| 136 | ;Screen message
|
|---|
| 137 | D BMES^XPDUTL(.ERROR)
|
|---|
| 138 | Q
|
|---|
