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

IBDFC1.m

Go to the documentation of this file.
  1. IBDFC1 ;ALB/CJM - ENCOUNTER FORM - CONVERTED FORMS LIST ;MAR 3, 1995
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
  1. ;
  1. LIST ;
  1. N IBCLINIC,IBTKFORM,IBTKBLK,IBAPI
  1. S (IBTKFORM,IBTKBLK,IBCLINIC)=""
  1. S IBAPI("INDEX")="D IDXFORMS^IBDFC1"
  1. S IBAPI("SELECT")="D SELECT^IBDFC1"
  1. D EN^VALM("IBDFC CONVERSION LOG")
  1. D VALMSG^IBDFC
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ONENTRY ;
  1. D IDXFORMS
  1. Q
  1. ONEXIT ;
  1. K ^TMP("IBDF",$J,"CONVERTED FORMS")
  1. Q
  1. ;
  1. HDR ;
  1. S VALMHDR(1)=" *** LOG OF FORMS THAT HAVE BEEN CONVERTED FOR SCANNING ***"
  1. Q
  1. ;
  1. IDXFORMS ;build a list of converted forms
  1. N IEN
  1. K @VALMAR
  1. S VALMCNT=0
  1. S IEN=0 F S IEN=$O(^IBD(359,IEN)) Q:'IEN D ENTRY
  1. Q
  1. ;
  1. ENTRY ;adds an entry to the array
  1. N NODE,FORM,WARNING,REPLACED
  1. S NODE=$G(^IBD(359,IEN,0))
  1. Q:NODE=""
  1. S FORM=+NODE
  1. S VALMCNT=VALMCNT+1
  1. S WARNING=$S($O(^IBD(359,IEN,1,0)):"YES",1:"NO ")
  1. S REPLACED=$S($P(NODE,"^",5):"YES",1:"NO ")
  1. S @VALMAR@(VALMCNT,0)=$J(VALMCNT,3)_" "_$$LJ^XLFSTR($P(NODE,"^",3),30)_" "_$$LJ^XLFSTR($$FMTE^XLFDT($P(NODE,"^",4),"2D"),10)_" "_$$CJ^XLFSTR(WARNING,8)_" "_$$CJ^XLFSTR(REPLACED,18)
  1. D FLDCTRL^VALM10(VALMCNT) ;set video for ID column
  1. I WARNING="YES" D CNTRL^VALM10(VALMCNT,52,3,IOINHI,IOINORM,0)
  1. I REPLACED="NO " D CNTRL^VALM10(VALMCNT,69,2,IOINHI,IOINORM,0)
  1. S @VALMAR@("IDX",VALMCNT,VALMCNT)=FORM_"^"_IEN
  1. Q
  1. ;
  1. SELECT ;returns IBFORM,IBCNVRT
  1. N SEL
  1. K DIR
  1. D EN^VALM2(XQORNOD(0),"S")
  1. S SEL=$O(VALMY(""))
  1. S IBFORM=$S('SEL:"",1:+$G(@VALMAR@("IDX",SEL,SEL)))
  1. S IBCNVRT=$S('SEL:"",1:$P($G(@VALMAR@("IDX",SEL,SEL)),"^",2))
  1. Q
  1. ;
  1. WARNINGS ;displays conversion warnings
  1. N IBFORM,IBARY,IBHDRRTN,IBCNVRT
  1. D SELECT
  1. Q:'IBCNVRT
  1. S IBARY="^IBD(359,"_IBCNVRT_",1)"
  1. S IBHDRRTN="D WARNHDR^IBDFC1"
  1. D EN^VALM("IBDE TEXT DISPLAY")
  1. S VALMBCK="R"
  1. Q
  1. WARNHDR ;
  1. S VALMHDR(1)=" *** Conversion Warnings For "_$P($G(^IBD(359,IBCNVRT,0)),"^",3)_" ***"
  1. Q
  1. ;
  1. DELFORM ;used to delete forms from other places than the clinic setup screen
  1. N CLINIC,IBFORM,IBCNVRT,BLOCK,NOCANDO,SETUP,ARY
  1. S NOCANDO=0,ARY="^TMP(""IBDF"",$J,""TEMPORARY CLINIC LIST"")"
  1. K @ARY
  1. S VALMBCK="R"
  1. I $G(IBAPI("SELECT"))'="" X IBAPI("SELECT")
  1. Q:'IBFORM
  1. D CLINICS^IBDFU4(IBFORM,ARY)
  1. I $G(@ARY@(0)) D
  1. .W !,"Cannot be deleted, the form is in use!"
  1. .D LIST^IBDFU4(ARY,IOSL)
  1. I '$G(@ARY@(0)) D
  1. .D DELETE^IBDFU2C(.IBFORM,357,1)
  1. .I '$G(IBFORM) D
  1. ..K DIK,DA S DIK="^IBD(359,",DA=IBCNVRT D ^DIK K DIK,DA
  1. ..D IDXFORMS
  1. K @ARY
  1. Q
  1. ;
  1. PURGE ;purge the conversion log
  1. N SDATE,IBCNVRT,NODE
  1. S VALMBCK="R"
  1. W !,"What is the last dated entry in the conversion log that should be deleted?"
  1. K DIR S DIR(0)="D"
  1. S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-25))
  1. D ^DIR
  1. I '$D(DIRUT),Y>0,Y'>DT S SDATE=Y D
  1. .K DIK S DIK="^IBD(359,"
  1. .S IBCNVRT=0 F S IBCNVRT=$O(^IBD(359,IBCNVRT)) Q:'IBCNVRT S NODE=$G(^IBD(359,IBCNVRT,0)) I $P(NODE,"^",4),$P(NODE,"^",4)'>SDATE S DA=IBCNVRT D ^DIK
  1. .D IDXFORMS
  1. K DIK,Y,DIR,DA,X
  1. Q