Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDMFFS

BDMFFS.m

Go to the documentation of this file. 
  1. BDMFFS ; cmi/anch/maw - DMS FLOW SHEET MANAGEMENT UTILITY ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;;AUG 11, 2006
  1.  ;
  1.  ;This routine was originally marked as Patch #5
  1.  ;but is not called from any routine.  The protocols
  1.  ;in this uci were not in Patch 4 so I did not include
  1.  ;this routine in patch 5 - FASCADD+8 calls non existent
  1.  ;routine BDMFFS1
  1.  ;AFTER REVIEW THE ROUTINE IS NOW INCLUDED IN PATCH #5
  1.  ;I HAVE SIMPLY COMMENTED OUT THE CALL TO THE NONEXISTENT
  1.  ;ROUTINE
  1.  ;
  1.  ;UTILITY PROGRAM TO MANAGE FLOW SHEET CREATION AND EDITING
  1. FS ;EP;FLOW SHEET MANAGEMENT
  1.  S IOP="HOME"
  1.  D ^%ZIS
  1.  D FS1 Q:$D(BDMQUIT)!$D(BDMOUT)
  1. FSEXIT K BDMQUIT,BDMOUT,BDMJ,BDMX,BDMY,BDMFSDA,BDMFSNAM,BDMCINK,BDMCINK0,BDMCDA,BDMWHICH,BDMADA,BDMANAM,BDMFSF,BDMCANON,BDMGO
  1.  K ^TMP("BDMVR",$J)
  1.  Q
  1. FS1 D FSEXIT
  1.  D FSDISP
  1.  Q
  1.  D FSHEAD
  1.  S DIR(0)="SO^1:Diagnostic/Treatment Flow Sheets;2:Lab Flow Sheets"
  1.  S DIR("A")="Which one"
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  S BDMWHICH=$S(Y=1:"RX",1:"LAB")
  1.  D FSRX
  1.  Q
  1. FSRX ;PROCESS FLOW SHEET
  1.  F  D FSRX1 Q:$D(BDMQUIT)!$D(BDMOUT)
  1.  K BDMQUIT
  1.  Q
  1. FSRX1 ;
  1.  W @IOF
  1.  W !?10,"Select one of the following ",!?10
  1.  I BDMWHICH="RX" D
  1.  .W "DIAGNOSIS/TREATMENT"
  1.  .S DIR(0)="SO^1:Diagnosis;2:ADA Code;3:Medication;4:Procedure (Medical);5:Patient Education Topic;6:Health Factors;7:Problem List Diagnosis"
  1.  I BDMWHICH="LAB" D
  1.  .W "LAB"
  1.  .S DIR(0)="SO^1:Cholesterol;2:Creatinine;3:Glucose;4:HGB A1C;5:Pap Smear;6:Triglycerides;7:Urine Protein;8:Urinalysis"
  1.  S DIR("A")="Which one"
  1.  W " Flow Sheets to review."
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  I BDMWHICH="RX" D
  1.  .I Y=1 S BDMANAM="DIAGNOSIS"
  1.  .I Y=2 S BDMANAM="ADA CODE"
  1.  .I Y=3 S BDMANAM="RX"
  1.  .I Y=4 S BDMANAM="PROCEDURE (MEDICAL)"
  1.  .I Y=5 S BDMANAM="PATIENT ED TOPIC"
  1.  .I Y=6 S BDMANAM="HEALTH FACTORS"
  1.  .I Y=7 S BDMANAM="PROBLEM LIST DIAGNOSIS"
  1.  .S BDMADA=$O(^AMQQ(5,"B",BDMANAM,""))
  1.  .I 'BDMADA D  Q
  1.  ..W !!,"A taxonomy can not be created for this attribute.  Ask your"
  1.  ..W !,"system manager to add ",BDMX," as an attribute then try again."
  1.  .S BDMCINK=$P(^AMQQ(5,BDMADA,0),U,5)
  1.  .S BDMFSF=U_$P(^AMQQ(5,BDMADA,0),U,18)
  1.  .S BDMCINK0=$G(^AMQQ(1,BDMCINK,0))
  1.  .Q:BDMCINK0=""
  1.  .D FSDISP:BDMCINK
  1.  I BDMWHICH="LAB" D
  1.  .S X=Y(0)
  1.  .X ^%ZOSF("UPPERCASE")
  1.  .S BDMX=Y
  1.  .D LABFS
  1.  Q
  1. LABFS ;LAB FLOW SHEET
  1.  Q
  1. FSDISP ;DISPLAY FLOW SHEET
  1.  D VALM("BDM FLOW SHEET LIST")
  1.  Q
  1. FSHEAD ;PRINT HEADER FOR FLOW SHEET MANAGEMENT
  1.  W @IOF
  1. FSHEAD1 N X
  1.  F X="DIABETES MANAGEMENT SYSTEM","FLOW SHEET MANAGEMENT" D
  1.  .W !?(80-$L(X))\2,X
  1.  Q
  1. DXHEAD ;PRINT HEADER FOR FLOW SHEET MANAGEMENT
  1.  W @IOF
  1.  D FSHEAD1
  1.  N X
  1.  F X="Diagnosti/Medication Flow Sheets"
  1.  W !?(80-$L(X))\2,X
  1.  Q
  1. FSDH ;DISPLAY HEADER FOR FLOW SHEET SYSTEM
  1.  Q
  1. FSADD ;EP;ENTER A NEW FLOW SHEET
  1.  S DIR(0)="FO^3:30"
  1.  S DIR("A")="Flow Sheet Name"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y="" S BDMQUIT="" D TABACK Q
  1.  S (X,BDMFSNAM)=Y
  1.  S DIC="^APCHSFLC("
  1.  S DIC(0)="L"
  1.  D FILE^BDMFDIC
  1.  S BDMFSDA=+Y
  1.  I 'BDMFSDA D TABACK Q
  1.  D FSCEDIT
  1.  D FSCLIST
  1. TABACK S BDMGO="FS"
  1.  D BACK
  1.  Q
  1. FSEDIT ;EP;EDIT AN EXISTING FLOW SHEET
  1.  D SELECT
  1.  I $D(BDMQUIT) K BDMQUIT D TEBACK Q
  1.  D FSCLIST
  1. TEBACK S BDMGO="FS"
  1.  D BACK
  1.  Q
  1. SELECT ;SELECT AN EXISTING FLOW SHEET
  1.  S DIR(0)="NO^1:"_BDMJ
  1.  S DIR("A")="Which Flow Sheet"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  Q:'$D(BDMJ(Y))
  1.  S BDMFSDA=+BDMJ(Y)
  1.  S BDMFSNAM=$P(BDMJ(Y),U,2)
  1.  D FSCLIST
  1.  Q
  1. FSCEDIT ;EP;EDIT A FLOW SHEET COMPONENT
  1.  S DA=BDMFSDA
  1.  S DIE="^APCHSFLC("
  1.  S DR="[BDM FLOW SHEET COMPONENT]"
  1.  D DDS^BDMFDIC
  1.  S BDMGO="FSC"
  1.  D BACK
  1.  Q
  1. FSINIT ;EP;INITIALIZE ARRAY FOR FLOW SHEET DISPLAY
  1.  K ^TMP("BDMVR",$J),BDMJ
  1.  S VALMCNT=0
  1.  S X="     NO. Flow sheet"
  1.  D Z(X)
  1.  S X="     --- ------------------------------"
  1.  D Z(X)
  1.  N I,J,X,Y,Z
  1.  S I=0
  1.  S X=""
  1.  F  S X=$O(^APCHSFLC("B",X)) Q:X=""  D
  1.  .S Y=0
  1.  .F  S Y=$O(^APCHSFLC("B",X,Y)) Q:'Y  D
  1.  ..S I=I+1
  1.  ..S A="    "_I
  1.  ..S:$L(A)=5 A=" "_A
  1.  ..S A=A_"   "_X
  1.  ..D Z(A)
  1.  ..S BDMJ(I)=Y_U_X
  1.  I '$D(^TMP("BDMVR",$J)) D
  1.  .S VALMCNT=2
  1.  .S X="NO FLOW SHEET ON FILE FOR "_BDMX
  1.  .D Z(X)
  1.  S BDMJ=I
  1.  Q
  1. VALM(BDMX) ;VALM INTERFACE
  1.  S VALMCC=1 ;1=screen mode, 0=scrolling mode
  1.  D TERM^VALM0
  1.  D EN^VALM(BDMX)
  1.  D CLEAR^VALM1
  1.  Q
  1. FSCLIST ;EP;TO DISPLAY ITEMS ON FLOW SHEET LIST
  1.  D VALM("BDM FLOW SHEET COMPONENT LIST")
  1.  Q
  1. FSCINIT ;EP;TO LIST ITEMS ON FLOW SHEET
  1.  N A,B,J,X,Y,Z,BDMTYPE,BDMLABEL
  1.  K ^TMP("BDMVR",$J),BDMJ,BDMCS
  1.  S VALMCNT=0
  1.  S X="     "_BDMFSNAM
  1.  D Z(X)
  1.  S X="   "
  1.  D Z(X)
  1.  S X="     Flowsheet Components"
  1.  D Z(X)
  1.  S X="     NO.  ORDER  TYPE                 LABEL                 WIDTH"
  1.  D Z(X)
  1.  S X="     ---  -----  -------------------  --------------------  -----"
  1.  D Z(X)
  1.  S (J,BDMX)=0
  1.  F  S BDMX=$O(^APCHSFLC(BDMFSDA,1,"B",BDMX)) Q:'BDMX  D
  1.  .S BDMCDA=0
  1.  .F  S BDMCDA=$O(^APCHSFLC(BDMFSDA,1,"B",BDMX,BDMCDA)) Q:'BDMCDA  D
  1.  ..S X=$G(^APCHSFLC(BDMFSDA,1,BDMCDA,0))
  1.  ..Q:X=""
  1.  ..S J=J+1
  1.  ..S A="     "_J
  1.  ..S:$L(A)=6 A=A_" "
  1.  ..S A=A_"    "
  1.  ..S A=A_$P(X,U)
  1.  ..S:$L($P(X,U))=1 A=A_" "
  1.  ..S A=A_"    "
  1.  ..S BDMTYPE=$P($G(^APCHSFLI(+$P(X,U,2),0)),U)
  1.  ..S BDMTYPE=BDMTYPE_$E("                    ",1,20-$L(BDMTYPE))
  1.  ..S A=A_BDMTYPE
  1.  ..S A=A_" "
  1.  ..S BDMLABEL=$P(X,U,3)
  1.  ..S BDMLABEL=BDMLABEL_$E("                    ",1,20-$L(BDMLABEL))
  1.  ..S A=A_BDMLABEL
  1.  ..S A=A_"   "
  1.  ..S BDMWIDTH=$P(X,U,4)
  1.  ..S A=A_BDMWIDTH
  1.  ..S X=A
  1.  ..D Z(X)
  1.  ..S BDMJ(BDMFSDA,J)=BDMCDA_U_A
  1.  ..D MEMLIST
  1.  S BDMJ=J
  1.  Q
  1. FSCADD ;EP;TO ADD ITEM TO FLOW SHEET
  1.  K BDM
  1.  N X,Y
  1.  I BDMANAM="DIAGNOSIS"!(BDMFSNAM="PROBLEM LIST DIAGNOSIS") D  I 1
  1.  .S X=0
  1.  .F  S X=$O(^APCHSFLC(BDMFSDA,1,X)) Q:'X  D
  1.  ..S Y=$G(^APCHSFLC(BDMFSDA,1,X,0))
  1.  ..S:$P(Y,U)]"" BDM(X)=$P(Y,U)_U_$S($P(Y,U,2)]"":$P(Y,U,2),1:$P(Y,U))
  1.  .Q:$D(BDMQUIT)
  1.  .S X=$P(BDM("LOW"),U)
  1.  E  D
  1.  .D CLEAR^VALM1
  1.  .W !?5,"Select an item to ADD to the"
  1.  .W !!?5,BDMFSNAM," Flow Sheet"
  1.  .S DIC=BDMFSF
  1.  .S DIC(0)="AEMQZ"
  1.  .S DIC("A")="Which "_BDMANAM_": "
  1.  .W !
  1.  .D DIC^BDMFDIC
  1.  .I +Y<1 S BDMQUIT="" Q
  1.  .S BDM("LOW")=+Y
  1.  .D X
  1.  .S BDM("HIGH")=""
  1.  I $D(BDMQUIT) D FSCBACK Q
  1.  S DA(1)=BDMFSDA
  1.  S DIC="^APCHSFLC("_BDMFSDA_",1,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")=".02////"_BDM("HIGH")
  1.  D FILE^BDMFDIC:'$D(^APCHSFLC(BDMFSDA,1,"B",X))
  1. FSCBACK S BDMGO="FSC"
  1.  D BACK
  1.  Q
  1. X ;EVALUATE X FOR PROPER INTERNAL VALUE
  1.  I BDMANAM="ADA CODE" S X=Y(0,0)
  1.  I BDMANAM="RX" S X=+Y
  1.  I BDMANAM="PROCEDURE (MEDICAL)" S X=Y(0,0)
  1.  I BDMANAM="PATIENT ED TOPIC" S X=+Y
  1.  I BDMANAM="HEALTH FACTORS" S X=+Y
  1.  I BDMANAM="PROBLEM LIST DIAGNOSIS" S X=Y(0,0)
  1.  Q
  1. FSCDEL ;EP;TO DELETE ITEM FROM FLOW SHEET
  1.  D FSCSEL
  1.  I $D(BDMQUIT) K BDMQUIT D FSCBACK Q
  1.  N BDMI,BDMX
  1.  F BDMI=1:1 S BDMX=$P(BDMY,",",BDMI) Q:BDMX=""  D
  1.  .Q:'$D(BDMJ(BDMFSDA,BDMX))
  1.  .S BDMCDA=+BDMJ(BDMFSDA,BDMX)
  1.  .S DA(1)=BDMFSDA
  1.  .S DA=BDMCDA
  1.  .S DIK="^APCHSFLC("_DA(1)_",1,"
  1.  .D DIK^BDMFDIC
  1.  S BDMGO="FSC"
  1.  D BACK
  1.  Q
  1. FSCSEL ;EP;SELECT EXISTING ITEM FROM A FLOW SHEET
  1.  S DIR(0)="LO^1:"_BDMJ
  1.  S DIR("A")="Whick Flow Sheet Component(s)"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  S BDMY=Y
  1.  Q
  1. BACK ;SETUP FOR RETURN TO LISTMAN
  1.  S VALMBCK="R"
  1.  D FSINIT:BDMGO="FS"
  1.  D FSCINIT:BDMGO="FSC"
  1.  D MEMINIT:BDMGO="FSM"
  1.  D TERM^VALM0
  1.  Q
  1. MEMBERS ;EP;TO SPECIFY THE MEMBERS FOR A FLOW SHEET COMPONENT
  1.  D FSCSEL
  1.  I $D(BDMQUIT) K BDMQUIT D FSCBACK Q
  1.  F BDMI=1:1 S BDMX=$P(BDMY,",",BDMI) Q:BDMX=""!$D(BDMQUIT)  D
  1.  .Q:'$D(BDMJ(BDMFSDA,BDMX))
  1.  .S BDMCDA=+BDMJ(BDMFSDA,BDMX)
  1.  .Q:'BDMCDA
  1.  .S BDMTYPE=$G(^APCHSFLI(+$P($G(^APCHSFLC(+BDMFSDA,1,+BDMCDA,0)),U,2),0))
  1.  .D MEMDISP
  1.  Q
  1. MEMSEL ;SELECT THE MEMBER OF THE COMPONENT TO EDIT OR DELETE
  1.  S DIR(0)="LO^1:"_BDMJ
  1.  S DIR("A")="Whick Component Members(s)"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  S BDMY=Y
  1.  Q
  1. MEMADD ;EP;TO ADD MEMBERS TO A FLOW SHEET COMPONENT
  1.  S BDMTYPE=$G(^APCHSFLI(+$P($G(^APCHSFLC(+BDMFSDA,1,+BDMCDA,0)),U,2),0))
  1.  F  D MADD1 Q:$D(BDMQUIT)
  1.  K BDMQUIT
  1.  D MBACK
  1.  Q
  1. MADD1 W @IOF
  1.  W !?5,"Select"
  1.  W !?5,$P(BDMTYPE,U),?25,"to add to the"
  1.  W !?5,$P(BDMTYPE,U),?25,"component of the "
  1.  W !?5,BDMFSNAM,?25,"Flow Sheet"
  1.  S DIC=+$P(BDMTYPE,U,2)
  1.  I 'DIC S BDMQUIT="" Q
  1.  S DIC=^DIC(DIC,0,"GL")
  1.  I DIC="" S BDMQUIT="" Q
  1.  S BDMDIC=DIC
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which "_$P(BDMTYPE,U)_": "
  1.  W !
  1.  D DIC^BDMFDIC
  1.  I +Y<1 S BDMQUIT="" Q
  1.  S X=+Y_";"_$E(BDMDIC,2,99)
  1.  S $P(^APCHSFLC(BDMFSDA,1,BDMCDA,2,0),U,2)="9001020.15AV"
  1.  S DA(2)=BDMFSDA
  1.  S DA(1)=BDMCDA
  1.  S DIC="^APCHSFLC("_BDMFSDA_",1,"_BDMCDA_",2,"
  1.  S DIC(0)="L"
  1.  D FILE^BDMFDIC
  1.  Q
  1. MEMDEL ;EP;TO DELETE MEMBERS FROM A FLOW SHEET COMPONENT
  1.  N BDMY
  1.  D MEMSEL
  1.  I $D(BDMQUIT) K BDMQUIT D MBACK Q
  1.  F BDMI=1:1 S BDMX=$P(BDMY,",",BDMI) Q:BDMX=""  D
  1.  .Q:'$D(BDMJ(BDMFSDA,BDMCDA,BDMX))
  1.  .S DA=+BDMJ(BDMFSDA,BDMCDA,BDMX)
  1.  .S DA(2)=BDMFSDA
  1.  .S DA(1)=BDMCDA
  1.  .S DIK="^APCHSFLC("_DA(2)_",1,"_DA(1)_",2,"
  1.  .D DIK^BDMFDIC
  1. MBACK S BDMGO="FSM"
  1.  D BACK
  1.  Q
  1. DELETE ;EP;TO DELETE FLOW SHEET COMPONENT
  1.  Q
  1. MEMDISP ;DISPLAY MEMBERS OF A COMPONENT
  1.  D VALM("BDM FLOW SHEET MEMBERS")
  1.  Q
  1. MEMINIT ;EP;TO LIST ITEMS ON FLOW SHEET
  1.  K ^TMP("BDMVR",$J),BDMJ
  1.  S VALMCNT=0
  1.  S X="     "_$P(BDMTYPE,U)
  1.  D Z(X)
  1.  S X="     ---------------------------"
  1.  D Z(X)
  1.  N A,B,X,Y
  1.  S BDMMDA=0
  1.  F  S BDMMDA=$O(^APCHSFLC(BDMFSDA,1,BDMCDA,2,BDMMDA)) Q:'BDMMDA  D
  1.  .S X=$G(^APCHSFLC(BDMFSDA,1,BDMCDA,2,BDMMDA,0))
  1.  .Q:X=""
  1.  .S BDMGL=U_$P(X,";",2)
  1.  .S:$E(BDMGL,$L(BDMGL))="(" BDMGL=$E(BDMGL,1,$L(BDMGL)-1)
  1.  .S:$E(BDMGL,$L(BDMGL))="," BDMGL=$E(BDMGL,1,$L(BDMGL)-1)_")"
  1.  .S BDMDA=+X
  1.  .S X=$P($G(@BDMGL@(+X,0)),U,$S(BDMGL'["AUTTMSR":1,1:2))
  1.  .S A="     "_(VALMCNT-1)
  1.  .S:$L(A)=6 A=A_" "
  1.  .S A=A_"    "
  1.  .S A=A_X
  1.  .S X=A
  1.  .D Z(X)
  1.  .S BDMJ(BDMFSDA,BDMCDA,VALMCNT-2)=BDMMDA_U_A
  1.  S BDMJ=VALMCNT-2
  1.  Q
  1. MEMLIST ;LIST MEMBERS OF EACH COMPONENT FOR DISPLAY WITH COMPONENTS
  1.  N J,X,Y,BDMX,BDMMDA
  1.  S (J,BDMMDA)=0
  1.  F  S BDMMDA=$O(^APCHSFLC(BDMFSDA,1,BDMCDA,2,BDMMDA)) Q:'BDMMDA  D
  1.  .S X=$G(^APCHSFLC(BDMFSDA,1,BDMCDA,2,BDMMDA,0))
  1.  .Q:X=""
  1.  .S J=J+1
  1.  .S BDMGL=U_$P(X,";",2)
  1.  .S:$E(BDMGL,$L(BDMGL))="(" BDMGL=$E(BDMGL,1,$L(BDMGL)-1)
  1.  .S:$E(BDMGL,$L(BDMGL))="," BDMGL=$E(BDMGL,1,$L(BDMGL)-1)_")"
  1.  .S X=$P($G(@BDMGL@(+X,0)),U,$S(BDMGL'["AUTTMSR":1,1:2))
  1.  .S A="                 "_X
  1.  .S X=A
  1.  .D Z(X)
  1.  Q
  1.  S VALMSG="- Prev Screen  Q Quit  ?? More Actions"
  1.  Q
  1. Z(X) ;SET TMP GLOBAL
  1.  S VALMCNT=VALMCNT+1
  1.  S ^TMP("BDMVR",$J,VALMCNT,0)=X
  1.  Q